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XU140 

;  (SCRIP:  V19  ORIGIN:  PSUVM 

FILENAME:  AXI2DV  FOR 

SPOOLID:  2G2C  REGS:  2633 


AXI2DV  FOR 

CREATED:  06/20/89  15:36:06 

CLASS :  A  FORMAT : J 

COPY:  1  DUPLICATE:  1 


PRINTED  AT:  PSUVM  ID:  $PPCBP01  AT:  06/20/89  15:36:11 
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VENKATELVYARAN  SANKA  (V19) 


AXI2DV  FOR 


FOR 


A1  VM/SF  CMS  4-8602  (02/02/88) 


THE  PENNSYLVANIA  STAT 


FiL.E:  Axr: 


STIXXXXX  JOB 
*  jp  T^soo,  r,=  10000 
EXEC  FGM-iEFBR]4 

D  I)!l  V' J,-^REF-:-STIJ  .  1  19500. MYHIOO. LIB, DISr-{OLn, DEI, ETE)  , 

DSM-STU, 119500. MYHIOO. HERMES. CONV.SOLU. VIS 
n  DP  VOL---REF=tSTU.  1 19500  .  MYHIOO  .  LI  B,  DI SP={OLD,  DELETE  )  , 

DSN-  ST(i.  119500. MYHIOO. HERMES. CONV. LINE. VIS 
D  DD  VOL-REF^STU. 1 19500 . MYHIOO . LI B, D I SP= ( OLD , DELETE ) , 

DSN^STIJ.  1 19500.  MYHIOO.  HERMES.  CONV.  MASS.  VIS 
EXEC  FVCG, FARM. SOURCE^' OPT( 3 ) ' 

/  SYS  IN  DD  * 

D  '*******-  ^  *  X  -.T  *  *  *  w  X  *  -A  ******************************■■(•  I-  *  *  *  *  * 

C-  PROGRAM  NAME:  AXI2DV.F0R  * 

C"  AX  I  SYMMETRIC  TRANSONIC  NOZZLE  FLOW  * 

C-  IN  GENERAL  COORDINA.TE  SYSTEM  "' 

C*  USING  TIME  ITERATIVE  CD/CD  SCHEME  * 

C-  WITH  THIN-LAYER  APPROXIMATED  NAVIER-STOKE ' S  EQ .  * 

r-  -  -T  X  X  .r  *  *  +  ■‘'  *  *  *  X  ********************************  X  **--  +  ***  X  X  * 

C" 

C^  MAIM  PROGRAM 
C* 

IMPLICIT  REAL*8(A-H,0-Z) 

F.^RAMETER  (  I  Z=150  ,  JZ=100  ) 

C(.)MMON  .'^VECTOR/DQ(  I Z  ,  JZ  ,  4  )  ,  Q (  I Z ,  JZ ,  4 )  ,  F(  I Z ,  JZ ,  4  )  ,  G (  I  Z ,  JZ ,  4 )  , 

P( IZ, JZ) ,U( IZ, JZ), V(IZ, JZ) ,UN( IZ, JZ) , VN( IZ, JZ) 
COMMON/COORD/S A IX(IZ,JZ),SAIY(iZ,JZ), ETAX ( I Z , J  Z ) , ETAY ( I Z , J  Z ) 

,RJ( IZ, JZ) ,X( IZ, JZ),Y(IZ, JZ) ,DELTAU( IZ, JZ) 

•  ,ZHUT(IZ,JZ) 

>  , AREA( IZ) , 2MU( IZ, JZ) , A1 ( I Z , JZ ) , A2 ( IZ , JZ ) , A3 ( I Z , JZ ) , A4 ( I Z , JZ ) 
COMMON /CONST/AIN , ATH , RL , EXI , EYI , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 

P  RNT , PB , RM 1 , SUM ( 4 ) , ZMUO , REN , PRN , TWALL , TREF , COND 
COrlMON/CONSTl/CP  (  I Z ,  JZ  )  ,CV(  I Z,  JZ )  ,  GAMMA  (  I Z ,  JZ )  ,  GMl  (  IZ,  JZ)  ,  RGAS 
COMMON/TNTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV, ITIME, I  SUP , IVISC, IWALL 
DIMENSION  RHO( IZ, JZ) ,RHOU( IZ , JZ ) , RHOV ( I Z , JZ ) ,E( IZ, JZ) 

EQUIVALENCE (Q( 1, 1,1) ,RHO( 1, 1)),(Q(1,1,2 ) , RHOU ( 1 , 1) ) , 

(Q(l, 1,3) ,RH0V(1,1)), (Q(1,1,4),E(1, 1 ) ) 

CAL.L  ERRSET(208, 256,-1 ,0,0,0) 

CAr.L  INITIA 
DO  10  NADV-NBEG,NEND 
WRITE  (6,*)  N.ADV 
CALL  SOLVE 
CALL  CHECK 
10  CONTINUE 
CALI,  MASS 
CALL  OUTFL'T 
STOP 
END 
C* 

C-  SET  UP  INITIAL  CONDITION 
C' 

SURROUTINE  INITIA 

^  .  A-  ^  I  4,  +  4  ^  +  -Jr  *  *  -Jlr  ^  *  A  A  A  Jk  *  *  *  *  *  +  *  ★  *  y-  ★  -^r  I'r  'A-  V.'  -A-  A  ^  4r  *  *  4c  -Jf 

TMFINCIT  REAL*8( A-H, O-Z) 
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PARAMETER  (  I  Z=1 50  ,  JZ-^100  ) 

COMMON,/ VECTOR/nQ(  IZ,  J2,  4)  ,Q(  IZ,  JZ ,  4 )  ,  F (  I  Z ,  JZ ,  4  )  ,  G(  IZ,  JZ,  4)  , 

P( IZ, JZ) ,U( TZ, JZ) , V( IZ, JZ) ,UN{ IZ, JZ) , VN( IZ, JZ) 
CC'MMON  COORD  .^SA IX  (  I  Z  ,  JZ  )  ,  SAI  Y(  T  Z  ,  J2  )  ,  ETAX(  IZ,  JZ)  ,  ETAY  (  IZ,  JZ  ) 

, RJ( IZ, JZ) , X( IZ, JZ) , Y( IZ, JZ) , DELTAU( I Z, JZ) 

■  ,  TZ,  JZ) 

■  ,  AREA(  IZ)  ,  ZMU(  IZ,  JZ)  ,  A1  (  IZ,  JZ)  ,  A2(  IZ,  .IZ)  ,  A3(  IZ,  JZ)  ,  A4(  IZ,  JZ) 
COMM'  -N/  LuNST/'A  I N ,  ATH ,  R  I. ,  EX  I ,  EYI ,  OMEGAX ,  OMEGAY  ,  CEL ,  THETA ,  PO ,  TO  , 

FRNT, PB, RMl , SUM( 4 ) , ZMUO, REN, PRN, TWALL, TREE, COND 
COMMON/CONST1/CP( IZ, JZ) ,CV{ I Z , JZ ) , GAMMA( IZ, JZ) , GMl ( IZ, JZ) , RGAS 
COMMON/INTEG/ir,,  JL,  I  LI ,  JDl ,  NEND,  NBEG,  NADV,  ITIME,  ISUP,  IVISC,  IWALL 
COMMON  CFCOFF/  CPAl , CFA2 , CPA3 , CPA4, CPAS , CPA6 , CPA7 
,CPA8,CPA9,CPA10,ENE(101) 

DIMENSION  RHO( IZ, JZ) , RHOU( IZ, JZ) , RHOV( I Z , JZ ) , E ( I Z , JZ ) 

EQJT VALENCE (Q( 1,1,1), RHO( 1, 1 )),(Q(1,1,2), RHOU I  1,1)), 
(Q(l,l,3),RHOV(l,l)), (Q(1,1,4),E(1, 1)) 

Q  -r  +  *  A  *  *  '  i-  ***********************************%*********  .1.  *  -.ir  -A-  •>.  ■*■*  I-  -A-  *  * 

DIMENSION  SS{3500,4) 

NAHELIST/INPUT/IL, JL, MEND, PO, TO, CEL, OMEGAX, OMEGAY, RMl , AIN, FST, 
'NITER, ATH, RL, THETA, CPO,GAMMAO,NBEG, ITIME, ISUP, IVISC, IWALL, RH2 
,  I  READ, PRN, REN, TREE, ZMUO, TWALL, ESTY, PB, PRNT,COND 
C. . .  ISJP  =  0  EOR  PURE  SUBSONIC  FLOW 
C  1  FOR  TRANSONIC  FLOW 

C  3  FOR  PURE  SUPERSONIC  FLOW 

G.  .  .  MOT  SUITABLE  FOR  PURE  SUPERSONIC  FLOW  CALCUI.ATION 
C...  FP  ^  BACK  PRESSURE  FOR  ISUP^O 
r 

C  **  READ  INPUT  DATA 
READ(5, INPUT) 

WRITE (22, INPUT) 

C  SET  UP  GEOMETRY 
ILl-^IL-1 
Tr,i-,iL-i 

r 

CALL  CFCOEF 

C  WR  n’E(  6,  *  )  CPAl  ,  C,PA2  ,CFA3  ,  CPA4 ,  CPAS  ,  CPA6 ,  CPA7  ,  CPAS  ,  CPA9  ,  CPAI  0 

C 

FI-nARCOS( -1 . DO) 

Cl-(AIN-ATH)/2. 

C2/^  (AIN  +  ATH)/2  . 

DO  10  1  =  1,  IL 
IF( ISUP. Eg. 3) THEN 

AREA(  I  )=ATMt-(ATH-AIM)*r)FLOAT(  I-l)/DFLOAT(  ILl  ) 

ELSE 

C  AREA (  I  )  =  (Cl*DCOS(DFLOAT(  I  -1  )*2  .  *Pl/DFr,OAT(  ILl  )  )  +C2  )  *0  .  S 

APR -ATH/AIN 

XX  -nFLOAT( I-l )/DFLOAT( ILl ) *RL 
C  ARFA(  I  )--2 . 0*  (  ARR-1  .  )-^XX+*3  +  3 . 0*  ( ARR-1  .  )  *XX*  *2  +  1 . 0 

AREA ( I )=( ARR-1 . ) * ( XX * +2-4 . *XX+4 . )*XX**2+ 1.0 
END  IF 

10  CONTINUE 

IF( 1  READ. EQ. 2) THEN 
DO  18  1=1 , IL 

READ! 38, *  )  X( I ,  I  ) , AREA( 1  ) 

18  CONTINUE 
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ENOl  r 

DO  2  0  I ^ 1 ,  1 L 
DO  20  j-^i,jr, 

I  F  (  i  READ  ,  EQ  .  2  )  '['HEN 
X  (  I  ,  J  )  =X  (  I  ,  ]. ) 

ELSE 

X(  T  ,  J  )^nFLOAT(  I-l)/DFLOAT(  I  LI  )*RIi 
ENl-TF 

20  Y(  I  ,  .r)^DFLOAT(  J  -  1 ) /DFLOAT  (  JLl )  *  AREA  (  I  ) 

I F ( FS T . ME . 0 . DO . AND . I  SUP . EQ . 3 ) THEN 
D0^^(  FST-1 . 0  )/(  FSr**TLl  -1  .  )*RL 
DO  15  1=^1,  IL 

XL-DO* (FST"* ( I-l  )-l  .  )/(FST-l.  ) 

AREA(  I  )=ATN*-XL/RL*  (  A'!'H-AIN) 

DO  15  J=1,JL 
X(  T  ,  .T)=XL 

Y(  .t)=dFLOAT(  J-1)/DF[/)AT(  JL1)*AREA(  I  ) 

15  CONTINUE 
ELSE 
END  IF 

0-  STRETCH  THE  GRID  ALONG  Y-DTRECETIOM  IN  VISCOUS  CASE 
IF( IVISC.EC. 1 . AND. FSTY.NE.O.DO)THEN 
no  i?  1  =  1,  IL 
Y(I, 1)=0. 

DAO=( 1 . -FSTY)/{ 1 . -FSTY**JL1)*AREA( I ) 

DO  17  J=2,JL 

Y( I , J)=Y( I , J-1)+DA0*FSTY**( J-2) 

17  CONTINUE 
ELSE 
END  IF 

C  READ  GRID  FROM  DATA  FILE 
IF( TREAD. EQ. 1 ) THEN 
DO  25  1=1, I L 
DO  2  5  J.-:1,JL 

READ(38) 1 1 , JJ,X( I , J) , Y( I , J) 

25  CONTINUE 
ELSE 
END  IF 
ATn-Y( 1,JL) 

DO  J25  1=2,  I L 
IF(Y( I , JL) .LT.ATH)THEN 
ATH=Y( I , JL) 

XTH=X( I , JL) 

ELSE 
EMDT  F 

125  CONTINUE 

C  COORDINATE  TRANSFORMATION 
EX1-]  .0 
EYI=1 . 0 
DO  30  1  =  1,  IL 
I P  1  =  r  + 1 
IMl-I-1 

IF( I . EQ. 1 ) IM1=1 
IF(I . EQ. IL) IP1=IL 
D.SAI=2  .  *EXI 
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IF(  I  .EQ.  1  .OR.  I  .  EQ.  IDDSAI^EXI 
DO  30  J^1,JL 
■  TP  1  -,H  1 
JMl  .1-  1 

IF( J.EQ. 1)JM1=1 
IF( J. EQ. JL) JP1=JL 
DETA=2 . *EYI 

I F ( J . EQ . 1 . OR . J . EQ . JL ) DETA^EYl 
XSAI-(X{ IPl, J)-X( IMl, J) )/DSAI 
YSAI^(Y( IPl, J)-Y( IMl, J) )/DSAI 
XETA^(X(I, JP1)-X(I, JMl ) )/DETA 
YETA--  (  Y  (  I ,  JP 1 )  -  Y (  I ,  JMl )  )  /DETA 
I F ( J . EQ . 1 ) THEN 

XETA-XETA-0. 5*(X( I , J ) -2 . *X( I , J+1 ) fX( I , J+2) ) 

YETA=YETA-  0 .5*(Y(I,J)-2.*Y(I,J-"l)+Y(I,J  +  2)) 

ELSE 
END  IF 

IF(J.EQ.JL)  THEN 

XETA=(  3  .DO*X(  I  ,  JL)-4.  DO*X(  I  ,  JL-1 )  +  X(  I ,  JL-2  )  )'^0 . 5D0 
YETA=(3 .D0*Y( I , JL)-4.D0*Y( T , JL-1)+Y( I , JL-2) )*0. 5D0 
ELSE 
END  IF 

R JP-XSAI *YETA-XETA*YSAI 
RJ( I , J)^l ./RJP 
SA  r  X ( I , J ) =YETA/R JP 
SAIV( I , J)=-XETA/RJP 
ETAX( I , J)=-YSAI/RJP 
30  ETAY( I , J)=XSAI/RJr 
C  INITIALIZATION 

RGAS=8314. 3/20. 405 
R-RGAS 

DO  991  1=1, IL 
DO  991  J=1,JL 
TTT=3061 . IDO 

CALL  CPGAM ( CP ( I , J ) , CV ( I , J ) , GAMMA ( I , J ) , GMl ( I , J ) , RGAS , I , J , 
>  RHO ( I , J ) , RHOU ( I , J ) , RHOV (I,J),E(I,J), TTT ) 

991  CONTINUE 

C*  GIVE  THE  INITIAL  VALUE  OF  VISCOSTY 
C  TIN-TO* ( 1 . +0. 5*GM10*RM1**2 ) 

C  UTN=RM1*DSQRT(GAMMA0*R*TIN) 

C  PIN=PO* (TIN/TO ) ** (GAMMAO/GMIO ) 

C  RIN=PIN/(R*TIN) 

C  ZMUO=(RIN*UIN*AREA( 1 )*2 . )/REN 

C*  CALCULATE  METRIC  TERMS  AT  MID  POINTS 
C* 

CALL  MCONST 

C  **  SKIP  TO  RERUN  THE  CODE 
IF(NBEG.NE. 1)G0T0  300 
RM=0 . 04 
DO  50  1=1, IL 
Cn  IF( ISUP.EQ.O)THEN 

Ctt  RMTH=RM2 

Ct)  RM=RMl-tX(  I  ,  1)/RL*2  .  *(RMTH-RM1) 

CD  IF(X( I , 1) .GT. (0. 5*RL) )RM=RMTH-(X( I , 1 ) -0 . 5*RL)/RL*2 . 

CD  *(RMTH-RM1) 


h 


FlhK:  FF'-DV  FOR  A1  VM/?:P  CMS  4-8602  (02/02/88)  --  THE  PENNSYLVANIA  STA' 


CtT  ELSE 

C#  RM^RM1+DF],0AT(  I-l  )/DFLOAT(  I  LI )  *  (  RM2-RM1  ) 

Ct?  EM1>  IF 

OAI  L.  I  SENMA  (  T  ,  ATH ,  XTH  ,  RM  ) 

TS-TO, ( ] , +0, 5*GM1 ( I , 1 )*RM**2 ) 

UIL-RM*DSQRT(  GAMMA  (  1,1)  *R*TS) 

D('  so 

I F ( 1 , EQ . 1 . OR . I . EQ . I L ) THEN 

[F( I . EQ.  1 )SL/PE-(Y( I O , J)-Y( I , J) )/(X( T  +  ]  , J)-X( I , J)  ) 

I F( I . EQ. IL)SLOPE^(Y( I,J)-Y(I-1,J))/(X(I,J)-X(I-1,J)) 

E 

srLiFE-(Y(  I  +  l  ,  J)-Y(  I-l,  J)  )/(X(  1^1,  J)-X(  I-I,  J)  ) 

ENL-  IF 

DFNOM-^DSQRT  ( 1  .  +SLOPE*SLOPE) 

•I  (  r  ,  .J  )  -Utl /DENOM 
V  (  T  .  ,l )  =UU*  SLOPE/DENOM 

YN ( I , J ) =ETAX (I,J)*U(I,J) +ETAY ( I , J ) *V ( I , J ) 

';M(  I  ,  J)^SAIX(  I ,  J)*U(  I  ,  T)  (  SAIY(  I ,  J)*V(  I  ,  J) 

IFi  I . EQ. JL)THEN 

VN ( I , J ) =0 . 

rj(  :  ,  J  )-UU/' DENOM 

V(  T  ,  T)=-ETAX(  I  ,  .T)/ETAY(  I  ,  J)*U(  I  ,  J) 

UM(  I  ,  J)=^U{  I  ,  J)*SAIX(  I  ,  J)  +V(  I  ,  J)*SAIY(  I  ,  J) 

Er,.SE 
END  IE 

SO  CONTINUE 

C-  NO- SLIP  INITIAL  CONDITION 
IF( IVISC. EQ. 1 ) THEN 
DO  60  I"1 , IL 
U( I , JL)=0. 

V(  I  ,  JL)=--0. 

UN( I , JL)=0. 
it;  /  I  ,  .JL)=0. 

^0  CO.NTINUE 
ELSE 
END  IF 

EIGMAX=0 . 0 
DO  80  1=1, IL 
DO  80  J=l, JL 

TS-TO-  (U(  I  ,.J)**2+V(  I  ,  J)-^*2)/CP(  I  ,  J)*0. 5 
PS=F0/(T0/TS)**(GAMMA( I , J ) /GMl ( I , J ) ) 

IF(.J.EQ.  JL.AND.  I VI  SC  .  EQ .  1  )THEN 
I F ( I WALL . EQ . 1 ) TS=TWALL 
FS=P( I , J-1) 

ELSE 
ENDI  F 

RHO0---PS/R/TS 

RHO( I , J)=RHOO 

RHOU ( I , J ) =RHO (I,J)*U(I,J) 

RHOV( I , J)=RHO( I , J)*V( I ,  T) 

E( I , J)=RHO( I , J)*(CV( I , J)*TS+0. 5*(U{ I , J ) * *2 +V ( I , J ) * *2 ) ) 

80  P(I,J)=PS 

DO  90  1=1 , IL 
D(^  90  J  =  1,JL 

CO- DSQRT ( GAMMA ( 1 , J ) *  P ( I , J ) /RHO ( I , J ) ) 
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FILE: 


AXI2DV 


FOR 


A1  VM/SP  CMS  4-8602  (02/02/88) 


THE  PENNSYLVANIA  STAT 


ZM-^DSQRT(U(  I ,  J)  **2+V(  I  ,  J)**2  )/C0 
I F(COND.GT. 0.0. AND.ZM.lt. 1.0)  GOTO  210 
CX-DSgRT( SAIX( I,J)**2+SAIY(I,J)**2) 

CY-PSQRT(ETAX(  I  ,  J)  **2  +  F,TAY(  I ,  J)**2  ) 

CX- (UN( I , J) +CX*CO)/EXI 
CY  ■(VN( I , J) +CY*CO)/EYI 
C  FIGNN^CX 

C  IF(DABS(CY) .GT.EIGNN)E1GNN=DABS(CY) 

EIGNN^DSQRT(CX**2+CY**2 ) 

IF( ITIME . EQ. 1 )G0  TO  85 
IF  (GX.GE.  EIGMAX)EIGMAX-:-CX 
I F ( C Y . GT . F I GMAX ) E I GMAX^GY 
85  DEl,TAU(  I  ,  J)-CFL/EIGNN 
GOTO  90 
210  CONTINUE 

C  ZM-DSQRT( (U( I , J)**2+V( I , J)**2 )/C( I , J)**2 ) 

SX=UN( I , J) **2* ( 1 . D0-2M*-2 ) * *2 +4 . DO* ( U( I,J)**2+V(I,J)**2) 

•  *(SA1X(  I  ,  J)**2  +  SAIY{  I  ,  J) '■  *2) 

SY-VN( I , J)**2*( 1 . D0-ZM**2 ) * *2 +4 . DO* ( U( I , J ) **2  ^V( I , J ) *-2 ) 

'  * (ETAX( I , J) **2+ETAY( I , J) **2) 

E I GVX=0 . 5D0* ( UN ( I , J ) * ( 1 . DO  +  ZM*  *2 ) +DSQRT ( SX ) ) 

E I GVY^O . 5D0* ( VN ( I , J ) * ( 1 . DO  +  ZM*  *  2 ) +DSQRT ( SY ) ) 

DELTAU( I , J)=CFL/PSQRT(EIGVX**2+EIGVY**2 ) 

90  CONTINUE 

IF( ITIME. EQ. 1)RETURN 
DO  100  1^1, IL 
DO  100  J=1,JL 

100  DELTAU{ I , J )=CFL/EIGMAX 
RETURN 

300  CONTINUE 

310  READ(19, 720, END^1000)NDUM, ( SS{NDUM, K) , K^l , 4) 

GOTO  310 
1000  CONTINUE 
REWIND  19 
NEEG-NDUM+1 
NEND=NBEG UNITER- 1 
DO  320  N=1,NDUM 

320  WPITE( 19, 720)N, ( SS ( N , K ) , K=1 , 4 ) 

720  F0RMAT( 15, 3X, 4{ IX, E14 . 7 ) ) 

DO  330  1=1, I L 
DO  330  J=1,JL 

READ (66)  (Q(I,J,K),K=1,4) ,DELTAU( I , J) 

TCP=0.D0 

CALL  CPGAM(CP( I , J) ,CV( I , J) , GAMMA ( I , J ) , GMl ( I , J) , RGAS , I , J, 

>  RHO ( I , J ) , RHOU ( I , J ) , RHOV (I,J),E(I,J), TCP ) 

U ( I , J ) =RHOU ( I , J ) /RHO (I  J ) 

V( I , J)=RHOV( I , J)/RHO( I , J ) 

UM( T , J)=U( I , J)*SAIX( I , J) +V( I , J)*SAIY( I , J) 

VN( I, J)=U( I, J)*ETAX(I, J)+V(I, J)*ETAY(I, J) 

P(  I  ,  J)  =GM1(  I,  J)*(E(  I  ,  .T)-0. 5*RHO(I  ,  J)*(U(  I  ,  T  )  **2+V(  I  ,  J  ) -*2  )  ) 
330  CONTINUE 
REWIND  66 
RETURN 
END 
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FIl.K:  AX  ■  i'V  FOR  A1  VM/SP  CMS  4-8602  (02/02/88)  --  THE  PENNSYLVANIA  STA' 


SAFN^UITiNE  ISENMA(  I  ,  ATH,XTH,RM) 

p  -i-  -V  .p  -r  -V  X  x 

I M t  LICIT  RE A L* 8 ( A- H , O- Z ) 

F  ‘V'L' NETF.'R  (  I  160,  JZ^  I  00  ) 

CC'HM  (^OORO  SAIX(  IZ  J  Z  )  ,  SA I Y  (  I Z  ,  JZ  )  ,  ETAX(  IZ,  JZ)  ,  ET,AY  (  IZ,  JZ) 

,  R  J  (  1  Z  ,  ,TZ  )  ,  X  (  I Z  ,  JZ  )  ,  Y  (  I  Z  ,  .  O’, )  ,  LELTAU  {  I  Z  ,  JZ  ) 

-  ,ZMUT(TZ,:Z) 

,  AREA(  IZ  )  ,  ZMU(  IZ,  JZ  )  ,  A1  (  IZ,  JZ)  ,  A2  (  IZ,  JZ)  ,  A3  (  IZ,  JZ)  ,  A4(  IZ,  JZ  ) 
CCMMON/INTEG/ IL, JL, I  LI , JLl , NEND , NbEG , NADV , ITIME, TSUP,  IVISC, IWALJ, 
C!  F'lMCN  CONST  1/ CP  (  IZ,  TZ  )  ,  CV  (  I Z ,  JZ  )  ,  GAMMA  (  I  Z  ,  JZ  )  ,  GMM  I  Z  ,  JZ  )  ,  RGAS 

ARE  ■  (Y(  I  , JL)/ATH)**2 
RM1--FM*!  .  05 
KM2-RM*0  95 

i  F  (  X  (  I  ,  JL  )  .  GT  .  XA'H  )  THEN 
FMl^PM*! . 05 
RM2=RM*1 . 01 
E  r  o  t-: 

END  I  F 

GF 1 -GAMMA ( I , JL ) + 1 . 0 

GI-MG'-GPl/(  2  0-2.0"’GAMMA(I,  JL)  ) 

GSQRT=DSQPT(  GAMMA(I,JL)  ) 

Ci'iJM-GSQRT-  (GPl/2 . 0)  **GEXP 
ZM-RMl 

FO  1  -ZM'^GSQRT’^  (  i  .  0  +  0 . 5*GM1  (  I ,  JL)  *ZM*ZM)  **GEXP 
Fl-CNUM/FOl 
ZM----RM2 

FOl -ZM*G50RT+ ( 1 .0+0 . 5*GM1 ( I , JL ) *ZM*ZM ) * *GEXP 
F2  -CNDM/FOl 

10  RM3---FM1  --(RM2-RM1  )*(ARR-F1  )/(F2-Fl) 

ZM=FM3 

FO]  -ZM’^GSQRT*  (1.0  +  0, 5*GM1  (  I  ,  JL )  *ZM*ZM )  * *GEXP 
F3-CNUM/F01 
EPF  DABSAARR-F3  ) 

IF( ERR. LT. 1 . OD-4)  GO  TO  20 
RKl -RMl 
FI--F2 
RM;.  -RM3 
F2-F3 
GO  T'O  10 
20  PM-RH3 

WRITE(6,*)  I,AP,H,RM 

RETURN 

END 

r - 

Slip  ROUT  I  ME  SOLVE 
C* 

C*  SOr.VE  SUBROUTINE 
C  " 

IMPLICIT  REAL’*-8(  A-H.O-Z) 

PARAMETER  ( I Z=1 50 , JZ- 100 ) 

COMMOM/VECTOR/DQ( I Z ,  TZ , 4 ) , Q ( I Z, JZ, 4 ) , F ( I Z , JZ , 4 ) , G ( I Z , JZ , 4 ) , 

P( IZ, JZ) ,U( IZ, JZ) ,V( IZ, JZ) ,UN( IZ, JZ) , VN( IZ, JZ) 
COMMOM/COORD/SAIX( IZ, JZ) , SA I Y ( I Z , JZ ) , ETAX( IZ, JZ) , ETAY( IZ, JZ) 
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FII.F:  AXI2DV 


FOR 


A1  VM/SP  CMS  4-8602  (02/02/88) 


THE  PENNSYLVANIA  STA'J 


,FJ(J7.17.).X(IZ,JZ),Y(IZ,JZ)  ,DEr,TAU(  IZ,  JZ) 

,  /;mut(  iz,  jz) 


, AREA( IZ) , ZMU( IZ, JZ) , A1 ( IZ, JZ) , A2( IZ, JZ) , A3 ( IZ, JZ) , A4( IZ, JZ) 
COMMON  CONST/AIN, ATH, RL, EXI , EY I , OMEGAX , OMEGAY , CEL , THETA , FO , TC , 
PRNT, PB, RMl , SUM( 4) , ZMUO, REN, PRN , TWALL , TREE , COND 
OOMM'M  CONST 1 /CP( IZ, JZ) , CV( IZ, JZ) , GAMMA( IZ, JZ) , GMl ( IZ, JZ) , RGAS 
C''MM<IN  INTEG/  IL,  JL,  I  LI ,  JLl ,  NEND,  NBEG,  NADV,  ITIME,  ISUP,  IVISC,  IWALL 
DIMENSION  RHO( IZ, JZ) , RHOU{ IZ, JZ) ,RHOV( I Z , JZ ) , E ( I Z , JZ ) 
FO.niVAr,F.NOF(Q(  1 ,1,1),  RHO(  1,1)),(Q(1,1,2),  RHOU  (  1 ,  1  )  )  , 

(Q(l,  1,3),RH0V(1,1) ),  (Q(1,1,4),E(1, 1) ) 


•*■*■  +  +  ■*****■ 


r  •x  ★  ★  ★  • 


•■*•■*•*  -A-  * 


priS  CAiLCUI.ATIOM 

IF  (  I  V I  SC  .  EQ  .  1  )  CALL  MUI.AM 
I F ( PENT . NF . 0 . DO )  CALL  MUTUR 
CALL  RHS 

IF{ IVISC. EQ. 1 )CALL  VFHS 
■  CAL.CULATE  RESIDUAL 
r-  40  I--^!  ,  IL 
D.';  40  J-1,JL 
D'^  4'"^  I>1,4 

DJ(  ;  ,  /  K)^-DELTAU( I , J ) -DQ( I , J, K) 


.'A! -DIRECTION  4TH  ORDER  ARTIEICIAL  VISCOSITY 


i  F  1  MEOAX  .  NE  .  0  .  ODO  )  CALI.  ADDX 
.ETA-LIREC"ION  4TH  ORDER  ARTIFICIAL  VISCOSITY 
I  (  -^MECAY  .  ME  .  0  .  ODO  )  CALL  ADDY 
.VE  r.SAT -OPERATOR 


JEMD- JL 

IF( IVISC. EQ. 1)JEND=JL1 
DO  50  J=2,JEND 
CAIJ,  COEFX(  J) 

O'-  ';'F;E  r.FTA-OFFPATOR 


I  END-  I  LI 

IF( ISUP . EQ . 1 . OR . ISUP . EQ. 3 ) IEND=IL 
DO  5  5  I  =-2,  I  END 
CALL  COEFY(I) 

O"  UPDATING  VARIABLES 
C"- 

EIGMAX--0  . 

IPEG-l 

IF( ISUP . EQ . 3 ) IBEG^2 
DO  70  I=IBEG,IL 
DO  70  J-=:2,JEND 
RJJ-RJ(I, J)/Y(I, J) 

DO  60  K.-l,4 

60  Q^ I , J, K)-Q( I , J, K) fDQ( I , J,K)*RJJ 
fcP-0 . DO 
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Fir.E;  AXI2DV 


FOR 


A1  VM/SP  CMS  4-8602  (02/02/88) 


THE  PENNSYLVANIA  STA' 


CALL  CPGAM(CP( I, J) ,CV( I , J ) , GAMMA( I , J ) , GMl ( I , J) , RGAS, I, J, 

>  RHO ( I , J ) , RHOU ( I . J ) , RHOV (I,J),E(I,J), TCP ) 

U ( I „ J ) =RHOU ( I , J ) /RHO ( I , J ) 

V ( I , J ) =RHOV ( I , J ) /RHO ( I , J ) 

UN( I , J)=U( I, J)*SAIX( I, J) +V(I, J)*SAIY( I, J) 

VN ( I , J ) =U ( I , J ) *ETAX( I , J ) +V ( I , J ) *ETAY ( I , J ) 

P(  I  ,  J):-GM1  (  I ,  J)*{E(  I ,  J)-0. 5*RH0(  I,J)*(U(I,J)**2  +  V(I,J)**2)) 
C0-'^DSQRT(GAMMA(  I,  J)*P(  I,  J)/RHO(I,  J)  ) 

ZM:^DSQRT(U{  I ,  J)**2+V(  I ,  J)**2)/C0 
I F(COND.GT. 0.0. AND.ZM.lt. 1.0)  GOTO  210 
CX-DSQRT(SAIX( I , J)*SAIX( I , J ) +SAI Y( I , J ) *SAI Y( I , J) ) 

CY---DSQRT  ( ETAX  ( I  ,  J  )  *ETAX  (  I  ,  J )  +ETAY  (  I ,  J )  *ETAY  (  I  ,  J  )  ) 

CX-^(UN(  I  ,  J)  +CX*C0)/EXI 
CY-^(VN(  I,  J)+CY*CO)/EYI 
C  EIGNN=DABS(CX) 

C  IF(DABS(CY) .GT. EIGNN)  E IGNN=DABS ( CY ) 

EIGNN==DSQRT(CX**2+CY**2) 

IF( EIGNN. GT. EIGMAX)EIGMAX=EIGNN 

DELTAU( I , J)=ITIME*CFL/EIGNN+(1-ITIME)*DELTAU( I , J) 

GOTO  70 
210  CONTINUE 

SX-IIN(  I ,  J)**2*  ( 1  .D0-ZM**2  )**2  +  4.DO*(U(  I,J)**2+V(I,J)**2) 

■  ■MSAIX(I,  J)**2  +  SAIY(I.  J)**2) 

SY^=VN(  I  ,  J)**2*{1  .DO-ZM**2)**2  +  4.DO*(U(  I,  J)**2  +  V(  I  ,  J)**2) 

>  - (ETAX( I , J)**2+ETAY( I , J)**2) 

EIGVX-O. 5D0* (UN( I , J) * ( 1 . D0+ZM**2 ) +DSQRT( SX) ) 

E I GVY=0 . 5D0* ( VN ( I , J ) * ( 1 . D0+ZM**2 ) +DSQRT ( SY ) ) 

DELTAU( I , J)=CFL/DSQRT{EIGVX**2+EIGVY**2) 

70  CONTINUE 
C  * 

C  *  CENTERLINE  BOUNDARY  CONDITIONS 
CALL  CLBC 

IF( IVISC. EQ. 1 )CALL  WALLBC 

RETURN 

END 

c 

c*  SUBROUTINE  FOR  CALCULATING  METRIC  TERMS 
C*  AT  THE  MIDPOINT 

SUBROUTINE  MCONST 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( I Z=150 , JZ=100 ) 

COMMON/VECTOR/DQ (IZ,JZ,4),Q(IZ,JZ,4),F(IZ,JZ,4),G(IZ,JZ,4), 

P( IZ, JZ) ,U{IZ, JZ),V(IZ, JZ) ,UN(IZ, JZ) ,VN( IZ, JZ) 
COMMON/COORD/S A IX(IZ,JZ),SAIY(IZ,JZ), ETAX ( I Z , JZ ) , ETAY ( I Z , JZ ) 

,RJ( IZ, JZ) ,X( IZ, JZ) ,Y( IZ, JZ) ,DELTAU( IZ, JZ) 

>  ,ZMUT(IZ,JZ) 

’  , AREA ( I Z ) , ZMU ( I Z , JZ ) , A1 ( I Z , JZ ) , A2 ( I Z , J  Z ) , A3 ( I Z , JZ ) , A4 ( I Z , JZ ) 
COMMON/CONST/A I N , ATH , RL , EX I , EYI , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 
PRNT,PB,RM1, SUM(4) ,ZMUO,REN,PRN,TWALL,TREF,COND 
COMMON/CONSTl/CP ( I Z , JZ ) , CV ( I Z , JZ ) , GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV, ITIME, ISUP, IVISC, IWALL 
DIMENSION  RHO(I2, JZ) ,RHOU( IZ , JZ ) , RHOV ( I Z , JZ ) , E ( I Z , JZ ) 
E0UIVALENCE(Q( 1,1,1), RHO( 1,1)),(Q(1,1,2), RHOU( 1,1)), 

(Q( 1 , 1 , 3 ) , RHOV( 1 , 1 ) ) , (Q( 1 , 1 , 4 ) , E ( 1 , 1 ) ) 
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FILF, :  AXI2DV 


FOR 


A1  VM/SP  CMS  4-8602  (02/02/88) 


THE  PENNSYLVANIA  STA' 


0**  +  ^*-^*  +  :^************  ********************************************** 
DATA  FD3, OD3/1 .333333333333,0.333333333333/ 

DO  20  1=2, I L 
DO  20  J=1,JL1 
IF( I .EQ. IL)THEN 

X.^AI=0.5*(X(I,  J)+X(I,  J  +  1)-X(I-1,  J)-X(I-1,  J  +  1)  ) 

YSA1-0.5*(Y(I,  J)+Y(I,  J  +  .I)-Y{I-1,  J  +  1)  ) 

ELSE 

YSAI=0. 25*(Y(I+1, J+l)+Y( I + 1 , J ) - Y( I - 1 , J+1 ) -Y{ I - 1 , J ) ) 

XSAI=0.25*{X( I+l, J+l)+X( I+l, J)-X( I-l, J+1)-X(I-1, J) ) 

END  IE 

YETA=Y(  I  ,  .i  t-I  )  -  Y(  I ,  J) 

XETA=X(I, J+1)-X(I, J) 

RJJ=I ./(XSAI*YETA-XETA*YSAI ) 

A1 ( I , J)=RJJ* {FD3*YSAI**2+XSAI**2 ) 

A2( I , J)=-RJJ*OD3*XSAI*YSAI 

A3 ( I , J )=RJJ* ( YSAI**2+FD3*XSAI**2 ) 

A4( I , J )=RJJ* (XSAI**2+YSAI**2 ) 

20  CONTINUE 
RETURN 
END 

C - 

SUBROUTINE  SMOOTH 
C* 

C*  ADD  ARTIFICIAL  DI SSIPATIONAL  TERM  FOR  SA I , ETA-DIRECTION 
C* 

Q***************************************************************** 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( IZ=150 , JZ=100 ) 

COMMON/VECTOR/DQ( I Z , JZ , 4 ) , Q ( I Z , JZ , 4 ) , F ( I Z , JZ , 4 ) , G( I Z , JZ , 4 ) , 

P( IZ, JZ) ,U( IZ, JZ),V(IZ, JZ) ,UN(IZ, JZ) ,VN(IZ, JZ) 
COMMON/COORD/S A I X ( I Z , JZ ) , S A I Y ( I Z , JZ ) , ETAX ( I Z , JZ ) , ETAY ( I Z , JZ ) 

"  ,RJ(IZ,JZ),X(IZ,JZ),Y(IZ,JZ), DELTAU ( I Z , JZ ) 

>  ,ZMUT(IZ,JZ) 

>  , AREA \iZ) , ZMU ( I Z , JZ ) , A1 ( r  Z , JZ ) , A2 ( I Z , JZ ) , A3 ( I Z , JZ ) , A4 ( I Z , JZ ) 
COMMON/CONST/A I N , ATH , RL , EX I , EYI , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 

>  PRNT,PB,RM1, SUM(4) ,ZMUO,REN,PRN,TWALL,TREF,COND 
COMMON/CONSTl/CP ( I Z , JZ ) , CV ( I Z , JZ ) , GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV, ITIME, ISUP, IVISC,  IWALL 
DIMENSION  RHO( IZ, JZ) , RHOU( IZ, JZ) ,RHOV{ I Z , JZ ) , E ( I Z , JZ ) 
EQUIVALENCE(Q( 1, 1 , 1 ) , RHO ( 1 , 1 ) ) , (Q( 1, 1 , 2 ) , RHOU ( 1 , 1 ) ) , 

(Q(l,l,3),RHOV(l,l)), (Q(1,1,4),E(1,1)) 

(^-k^'^'kir-k'k^'k-kir'k'k’k'k'k'k-k’k-k-k-k-k-k-k-k'k'kir^'k'k'k^'k'kii'k'k'k'kic'k-k'k'k’k'k'kit'k-k'kir'k-k'k-k'k'k'k-k'k'kic-k'k 

DIMENSION  ADD(4) 

DIMENSION  PRE(4, 4) ,PADD(4) 

C  **  SAI-DIRECTION 
ENTRY  ADDX 
COEF=0 . 125DO*OMEGAX 
DO  70  J=1,JL 
DO  70  1=1, IL 
IF( I .EQ. 1)  GO  TO  10 
IF(I .EQ.2)  GO  TO  20 
IF( I .EQ. ILl)  GO  TO  30 
IF( I .EQ. IL)  GO  TO  40 
DO  5  K=l,4 
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5  ADD(K)^COEF*(Q(I+2, J,K)-4.*Q(I+1, J,K) 
f6.*Q(I, J,K)-4.*Q(I-1,J,K) 

+Q(I-2,J,K)) 

GO  TO  50 

10  DO  15  K=l,4 

QM=2.*Q(1,  jgK)-Q(2,  J,K) 

QMM=2 . *QM-Q( 1, J, K) 

15  ADD(K)^COEF* (Q( 1+2, J,K)-4. *Q( I+l, J,K) 

+6. *Q( I , J,K)-4. *QM+QMM) 

GO  TO  50 

20  DO  25  K:=l,4 

QMM=2 .*Q(1,J,K)-Q(2,J,K) 

25  ADD(K)=COEF*(Q( I+2,J,K)-4.*Q(I+1,J,K) 
t 6. *Q( I , J, K)-4. J,K) 

>  QMM ) 

GO  TO  50 

30  DO  35  K=l,4 

QFP-2 . *Q( I+l, J, K)-Q( I , J,K) 

35  ADD(K)=COEF* (QPP-4. *Q( I+1,J,K)+6.*Q(I,J,K) 
-4.*Q(I-l,J,K)-:-Q(I-2,J,K) 

) 

GO  TO  50 

40  DO  45  K=l,4 

QP=2.*Q(I, J,K)-Q(I-1, J,K) 

QPP=2.*QP-Q(I, J,K) 

45  ADD(K)=COEF*(QPP-4. *QP+6.*Q( I, J,K)-4. * 

Q(I-1, J,K)+Q(I-2, J,K)) 

50  CONTINUE 

CALL  PRECON ( I, J,PRE) 

CALL  MMV(4,PRE,ADD,PADD) 

DO  60  K=l,4 

60  DQ ( I , J , K ) -DQ ( I , J , K ) -PADD ( K ) /RJ ( I , J ) * Y ( I , J ) 

70  CONTINUE 
RETURN 

C  *  + 

C  ADD  ETA-DLRECTLON  4TH  ORDER  ARTLFLCLAL  VLSCOSLTY 

C  ** 

ENTRY  ADDY 
COEF^O. 125DO*OMEGAY 
DO  170  1=1, IL 
DO  170  J=1,JL 
IF( J.EQ. 1)  GO  TO  110 
IF(J.EQ.2)  GO  TO  120 
IF(J.EQ.JLl)  GO  TO  130 
IF(J.EQ.JL)  GO  TO  140 
DO  95  K=l,4 

95  ADD(K)=COEF*(Q( I , J+2 , K ) -4 . *Q( I , J+1 , K ) 

>  +6.*Q(I, J,K)-4.*Q(I, J-1,K) 

>  +Q(I,J-2,K)) 

GO  TO  150 

110  DO  115  K=l,4 

QM=2.*Q(I, 1,K)-Q(I,2,K) 

QMM=2.*QM-Q(I, 1,K) 

115  ADD(K)=COEF*(Q( I , J+2,K)-4. *Q( I , J+1,K) 

>  +6.*Q(I, J,K)-4.*QM+QMM) 
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GO  TO  150 
120  DO  125  K=l,4 

QMM=2. *Q(I, 1,K)-Q(I,2,K) 

125  ADD(K)=COEF* (Q( I , J+2 , K ) -4 . *Q ( I , J+1 , K ) 

>  +6.*Q(I, J,K)-4.*Q(I, J-1,K) 

+  QMM) 

GO  TO  150 
130  DO  135  K=l,4 

QPP=2.*Q(I, J+1,K)-Q(I, J,K) 

135  ADD(K)=COEF-(QPP-4. *Q( I , J+ 1 , K) +6 . *Q ( I , J , K ) 

-  -4.*Q(I, J-1,K)+Q(I, J-2,K) 

"  ) 

GO  TO  150 
140  DO  145  K=l,4 

QP=2.*Q(I, J,K)-Q(I, J-1,K) 

QPP^2.*QP-Q(I, J,K) 

145  ADD(K)=C0EF*(QPP-4. *QP+6. *0(1, J,K)-4. * 

>  Q(I, J-1,K)+Q(I, J-2,K)) 

150  CONTINUE 

CALL  PRECON(I, J,PRE) 

CALL  MMV(4,PRE,ADD,PADD) 

DO  160  K=l,4 

160  DQ( I, J,K)=DQ(I, J,K)-PADD(K)/RJ(I, J)*Y(I, J) 

170  CONTINUE 
RETURN 
END 
C 

C  **  SUBROUTINE  FOR  CENTER  LINE  BOUNDARY  CONDITIONS 
SUBROUTINE  BC 

C - 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( IZ=150, JZ=100 ) 

COMMON/VECTOR/DQ (IZ,JZ,4),Q(IZ,JZ,4),F(IZ,JZ,4),G(IZ,JZ,4), 

P( IZ, JZ) ,U(IZ, J2) ,V(IZ, JZ) ,UN( IZ, JZ) ,VN( IZ, JZ) 
COMMON/COORD/SAIX( IZ, JZ) , SAIY( IZ, JZ) , ETAX( IZ, JZ) , ETAY( IZ, JZ) 

>  ,RJ( IZ, JZ) ,X( IZ, JZ) , Y( IZ, JZ) ,DELTAU( IZ, JZ) 

>  ,ZMUT(IZ,JZ) 

>  , AREA( IZ) , ZMU( IZ, JZ) , A1 ( IZ, JZ) , A2( IZ, JZ) , A3( IZ, JZ) , A4( IZ, JZ) 
COMMON/CONST/A I N , ATH , RL , EX I , EY I , OMEGAX , OMEGAY , CFL , THETA , P  0 , TO , 

■>  PRNT,PB,RM1,  SUM(4)  ,ZMUO,REN,PRN,TWALL,TREF,COND 

COMMON/CONSTl/CP ( I Z , JZ ) , CV ( I 2 , JZ ) , GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, ILl , JLl , NEND, NBEG, NADV, ITIME, ISUP, I VI  SC, I WALL 
DIMENSION  RH0(I2, JZ) ,RHOU(IZ, JZ),RHOV(IZ, JZ) ,E(IZ, JZ) 

EQUI VALENCE (Q( 1, 1, 1),RH0(1, 1 )), (Q( 1,1,2 ),RHOU( 1,1) ), 

>  (Q(1,1,3),RH0V(1,1)), (Q( 1,1,4), E( 1,1)) 

DIMENSION  AM( IZ) ,BM( IZ) ,CM( IZ ) , DM{ I Z ) , PTEMP ( I Z ) 

DATA  SCONST/110./ 

ENTRY  CLBC 

C  *  THE  QUANTITIES  EXTRAPOLATED  ARE  U,P,T  AND  LET  V=0 
C 

IF(ISUP.EQ.3)THEN 
11=2 
ELSE 
11  =  1 
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END  IF 

DO  20  1=11, IL 
SY=SAIY( 1,1) 

EY=ETAY(I, 1) 

DENOM=SY-l . 5*EY 
I F ( I . EQ . 1 ) THEN 
UIM1=0. 

PIM1=0. 

RIM1=1 . 0 
ELSE 

UIM1=U( I-l , 1 ) 

PIM1=P( I-l, 1) 

RIM1=RH0( 1-1,1) 

END  IF 
V(I,1)=0. 

U( I , l)=(SY*UIMl-0. 5*EY*(4. *U{I,2)-U( 1,3)) )/DENOM 
UN(I, 1)=SAIX(I, 1)*U(I, 1) 

VN(I,1)=ETAX(I,1)*U(I,1) 

P( I , l)=(SY*PIMl-0. 5*EY*(4. *P( I,2)-P( I ,3) ) )/DENOM 

riv=i./Rgas 

TIM1=PIM1/RIM1*RIV 
T2=P( I,2)/RH0(I,2)*RIV 
T3=P(I,3)/RHO(I,3)*RIV 
T1=(SY*TIM1-0.5*EY*(4.*T2-T3) )/DEN0M 

CALL  CPGAM ( CP ( I , 1 ) , CV ( I , 1 ) , GAMMA( I , 1 ) , GMl ( I , 1 ) , RGAS ,1,1, 

>  RHO( 1,1), RHOU( 1,1), RH0V( I , 1 ) , E( I , 1 ) , T1 ) 

RHO ( I , 1 ) =P ( I , 1 ) /T1 *R I V 

RHOU( I, l)=RHO(I,l)*U(I,l) 

RHOV(I, l)=RHO(I,l)*V(I, 1) 

E(I,1)=P(I,1)/GM1(I,1)+0.5*RHO(I,1)*(U(I,1)**2+V{I,1)**2) 

20  CONTINUE 
RETURN 
C* 

ENTRY  WALLBC 

J=JL 

IBEG=1 

IF( ISUP.EQ.3)IBEG=2 
C*  SOLVE  THE  PRESSURE  EQUATION 
IF(ISUP.NE.3)THEN 
AM( ] )=0. 

BM(1)=1.5*(ETAX(1, J)**2+ETAY(1, J)**2)-(SAIX(1,  J)* 

>  ETAX(1, J)+SAIY(1, J)*ETAY(1, J) ) 

CM(1)=SAIX(1, J)*ETAX(1, J)+SAIY(1, J)*ETAY(1, J) 

DM(1)=(ETAX(1, J)**2+ETAY(1, J)**2)*(2.*P(1, J-1)-0.5*P(1, J-2) ) 

ELSE 

AM( 1 )=0. 

BM( 1 )=1 . 

CM(1)=0. 

DM(1)=P(1, J) 

END  IF 

DO  30  1=2, ILl 

CC1=SAIX(I, J)*ETAX(I, J)+SAIY(I, J)*ETAY(I, J) 

CC2=ETAX( I , J) **2+ETAY( I , J) **2 
AM( I )=-0. 5*CC1 
BM(I)=1.5*CC2 
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CM(  I  )=^0. 5*CC1 

DM( I )=CC2*(2 . *P( I, J-I )-0. 5*P( I , J-2) ) 

30  CONTINUE 

CC1=SAIX( IL, J)*ETAX( IL, J) +SAIY( IL, J)*ETAY( IL, J) 

CC2=ETAX( IL, J)**2+ETAY( IL, J)**2 

AM( IL)=-CC1 

BM( IL)=CC1+1 . 5*CC2 

CM( IL)=C. 

DM( IL)=CC2*(2.*P(IL, J-1)-0.5*P(IL, J-2) ) 

CALL  SYH(1, IL,AM,BM,CM,DM) 

DO  32  1=1 , IL 
32  PTEMP( I )=DM( I ) 

RIV=1 ./RGAS 
IF( IWALL.EQ.O)THEN 
IF(ISUP.EQ.3)THEN 
DM ( 1 ) =P ( 1 , J ) *RI V/RHO ( 1 , J ) 

ELSE 

T1=P(1, J-1)*RIV/RH0(1, J-1) 

T2=P( 1, J-2 )*RIV/RHO( 1, J-2) 

CC2=ETAX( 1, J)**2+ETAY( 1, J)**2 
DM( 1 )=CC2* (2 . *Tl-0. 5*T2 ) 

END  IF 

DO  34  1=2 , IL 

CC2=ETAX ( I , J ) *  *2  +ETAY ( I , J ) *  *2 
T1=P( I , J-1)*RIV/RH0( I , J-1) 

T2=P( I , J-2 ) *RIV/RHO( I , J-2 ) 

34  DM(I)=CC2*(2.*T1-0.5*T2) 

CALL  SYH( 1, IL, AM,BM,CM,DM) 

ELSE 
END  IF 

DO  40  I=IBEG, IL 
IF( IWALL.EQ.O)THEN 
TT=DM( I ) 

ELSE 

TT=TWALL 
END  IF 

PP=PTEMP( I ) 

U( I , JL)=0. 

V( I , JL)=0. 

RH(,)U{  I  ,  JL)=0. 

RHOV( I , JL)=0. 

RHO0=PP*RIV/TT 
RHO( I , JL)=RHOO 

CALL  CPGAM { CP ( I , JL ) , CV ( I , JL ) , GAMMA( I , JL ) , GMl ( I , JL ) , RGAS , I , JL , 
>  RHO( I , JL) ,RHOU( I , JL) ,RHOV( I, JL) ,E(I, JL) ,TT) 

E(I,JL)  =PP/GM1(I, JL) 

P( I , JL)=PP 
UN( I , JL)=0. 

VN( I , JL)=0. 

40  CONTINUE 
RETURN 
C* 

C*  LAMINAR  VISCOSITY  CALCULATION 
C* 

C  ENTRY  MULAM 
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C*  USE  SUTHERLAND  LAW 
C  DO  60  1=1, IL 

C  DO  60  J=1,JL 

C  TOS=TREF+SCONST 

C  TT=(E( I , J)/RHO( I , J)-0. 5*(U( I , J)**2+V( I , J)**2) )/CV( I , J) 

C  TTS=TT+SCONST 

C  ZMU( I , J)=ZMUO*TOS/TTS* (TT/TREF)**! . 5 

C  ZMU( I , J)=ZMUO 

C  ZMU( I , J)=ZMUO* (TT/TREF)**0. 67 

C  60  CONTINUE 
C  RETURN 

END 

r'-k^'k-k-k-k-k-k-k-k-k-rii-k-k 

SUBROUTINE  MULAM 

QrJri^-^iV*********- 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( 12=150, JZ=100 ) 

COMMON/VECTOR/DQ( I2,J2,4),Q(IZ,J2,4),F(IZ,JZ,4),G(I2,JZ,4), 

P ( I Z , JZ ) , U ( I Z , JZ ) , V ( I Z , JZ ) , UN ( I Z , JZ ) , VN ( I Z , JZ ) 

COMMON/COORD/SAIX( IZ, JZ) , SAIY( IZ, JZ) , ETAX( IZ, JZ) , ETAY( IZ, JZ) 

>  ,RJ( 12, JZ) ,X( 12, JZ) ,Y(IZ, JZ) ,DELTAU( 12, JZ) 

>  ,ZMUT(IZ,JZ) 

>  , AREA( IZ) ,ZMU( IZ, JZ) , Al( IZ, JZ) ,A2( IZ, JZ) , A3( IZ, JZ) ,A4( IZ, JZ) 
COMMON/CONST/AIN, ATH, RL, EX I , EYI , OMEGAX, OMEGAY, CFL, THETA, PO , TO , 

>  PRNT , PB , RMl , SUM ( 4 ) , ZMUC , REN, PRN , TWALL , TREF , COND 
COMMON/CONSTl/CP ( I Z , JZ ) , CV ( I Z , JZ ) , GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV, ITIME, ISUP, IVISC, IWALL 
DIMENSION  RH0(I2, JZ) ,RHOU{IZ, J2),RH0V( IZ, JZ) , E( IZ, JZ) 

EQUT VALENCE (Q( 1 ,1,1), RHO( 1 ,1)),(Q(1,1,2), RH0U( 1,1)), 

>  (Q(1,1,3),RH0V(1,1)), (Q(1,1,4),E(1,1)) 

Qriir*-!^*********^****^*****************^***^^************************* 

Bl=4. 3222 557667 160623D-06 
B2=3 . 8885996244952953D-08 
B3=-3 . 7263546610032919D-12 
DO  50  NN=1, IL 
DO  50  MM=1,JL 

TT=(E(NN,MM)/RHO(NN,MM)-0. 5*(U(NN,MM)**2+V(NN,MM)**2) )/CV(NN,MM) 
ZMU(NN,MM)=B1+B2*TT+B3*TT*TT 
50  CONTINUE 
RETURN 
END 

BOLDWIN  &  LOMAX  TURBULENCE  MODEL 
SUBROUTINE  MUTUR 

-k  k:  -k  -k  k:  ic  ic  -k  ir  'k  it  it  -k  ie  "k  -k  "k  'k  -k  "k  ir  -k  "k  -k  it  "k  ic  ic  ic  ic  'k  ic  ic  -k  if  ic  "k  "k  -k  -k  "k  -k  "k  'k  "k  "k  -k  "k  "k  "k  "k  -k  -k  -k  it  "k  ie  "k  "k  -k 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( IZ=150 , JZ=100 ) 

COMMON/VECTOR/DQ (IZ,JZ,4),Q(IZ,JZ,4),F(IZ,JZ,4),G(IZ,JZ,4), 

>  P( IZ, JZ),U( IZ, JZ),V{ IZ, JZ) ,UN(IZ, JZ) ,VN( IZ, JZ) 
COMMON/COORD/SA IX ( I Z , JZ ) , SAI Y ( I Z , JZ ) , ETAX ( I Z , JZ ) , ETAY ( I Z , JZ ) 

,RJ( IZ, JZ) ,X( IZ, JZ) , Y( IZ, JZ) ,DELTAU( IZ, JZ) 

•  ,ZMUT(IZ,JZ) 

>  , AREA( IZ) , ZMU( IZ, JZ) , Al( IZ, JZ) , A2( IZ, JZ) , A3( IZ, JZ) , A4( IZ, JZ) 
COMMON/CONST/A I N , ATH , RL , EX I , EY I , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 


17 


FILE:  AXI2DV 


FOR 


A1  VM/SP  CMS  4-8602  (02/02/88) 


THE  PENNSYLVANIA  STAT 


PRNT , PB , RMl , SUM ( 4 ) , ZMUO , REN , PRN , TWALL , TREF , COND 
COMMON/CONST 1/CP { I Z , JZ ) , CV ( I Z , JZ ) , GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , RGAS 
COMMON/ 1 NTEG/IL, JL,  I  LI , JLl , NEND, NBEG, NADV , ITIME, ISUP, IVISC, IWALL 
D I  MENS  I  ON  RHO ( I Z , JZ ) , RHOU ( I Z , JZ ) , RHOV (IZ,JZ),E(IZ,JZ) 
EQUIVALENCE(Q(1, 1, 1) ,RHO(l,l) ), (Q(l, 1,2) ,RHOU(l, 1) ) , 
(Q(l,l,3),RHOV(l,l)),(Q(l,l,4),E(l,l)) 

DIMENSION  YVERT( JZ) , ZMUI ( JZ) 

DATA  AP,CCP,CKLEB,CWK,VKCON,XK/26. ,  1.6,  .3,  .25,  .4,  .0168/ 

DATA  ZMUI/JZ*0.0/ 

DO  991  I  1  =  1,  IL 
I-I  I 

FYMAX  =0.0 
YMAX  =0.0 
UDIF=0 . 

YVERT(JL)  =0.0 

TAUW  =  ZMU(I,JL)*DABS(ETAY(I,JL)*(U(I,JL)-U(I,JL-1))- 

ETAX( I, JL)*(V( I , JL)-V( I, JL-1) ) ) 

CYP  =  DSQRT(RHO( I , JL) *TAUW)/ZmU( I , JL) 

C 

DO  10  KK  =  2, JLl 
K  -  JL-^l-KK 

YVER  =  YVERT(K+1)  +  1 . 0/DS0RT( ETAX( I , K ) * *2  +  ETAY( I , K) **2 ) 

OMG  =  DABS(  ETAY(I,K)*(U(I,K+1)-U(I,K-1))*.5 
+SAIY( I ,K)*(U( I,K)  -U(I-1,K)) 

-ETAX(  I  ,K)*(V(  I,K-a)-V(  I,K-1)  )*  .  5 
-SAIX(I,K)*(V(I,K)  -V(I-1,K))  ) 

YPLUS  =  CYP* YVER 

TURLEN  =  VKCON*YVER* ( 1 . ODO  -DEXP { -YPLUS/AP ) ) 

ZMUI(K)  =  RH0(I,K)*0MG*TURLEN**2 
FY  =  TURLEN/VKCON*OMG 
UTOTAL=  DSQRT(U( I,E)**2+V( I,K)**2) 

IF(UTOTAL.GE.UDIF)  UDIF=UTOTAL 
IF(FY  .LT.  FYMAX)  GO  TO  10 
FYMAX  =  FY 

YMAX  =  YVER 

10  YVERT(K)  =  YVER 

C 

VXDIF  =  UDIF 

C  WRITE(6,*)  1 1, K, TURLEN, YVER, OMG, FY, FYMAX 

FWAKE 1 = YMAX*  FYMAX 
FW A  KE  2  =CWK  *  YMAX  *  VXD I F  *  *  2 /FYMAX 
FWAKE  =DMIN1(FWAKE1, FWAKE2) 

C 

DO  20  KK  =  2,  JLl 
K  =  JL+l-KK 

FKLEB  =  {CKLEB*YVERT(K)/YMAX)**6 

FKLEB  =  l./(1.0  +  5.5*FKLEB) 

ZMUO  =  XK*CCP*RHO(I,K)*FWAKE*FKLEB 

IF(ZMUI(K) .GT.ZMUO)  THEN 
ZMUTUR  =  ZMUO 
ELSE 

ZMUTUR  =  ZMUI(K) 

END  IF 

ZMUT ( I , K ) =  ZMUTUR 
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ZMU(I,K)  =  ZMU(I,K)  +  ZMUTUR 
WRITE (77, 119)K, Y( I,K) , YVERT(K) ,U( I,K) ,ZMUI (K) ,ZMU0, ZMU( I,K) 
F>)RMAT(2X,  I3,6(2X,D13.6)  ) 

CONTINUE 

ZMUT  (  I  ,  1 )  =^0  . 

ZMUT( I , JL)=0. 

;-01  CONTINUE 
RETURN 
END 

^.IJORCE  TERM  JACOBIAN  MATRIX 
SUBROUTINE  DHDQ(D,I,J) 


IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( I Z=150 , JZ=100 ) 

COMHON/VECTOR/DQ (IZ,JZ,4),Q(IZ,JZ,4),F(IZ,JZ,4),G(IZ,JZ,4), 

P( IZ, JZ) ,U( IZ, JZ) ,V( IZ, JZ) ,UN( IZ, JZ) , VN( IZ, JZ) 
C0MM0N/C00RD/SAIX( IZ, JZ) ,SAIY(IZ, JZ),ETAX(IZ, JZ) ,ETAY(IZ, JZ) 

>  , R J ( I Z , JZ ) , X ( I Z , JZ ) , Y ( I Z , JZ ) , DELTAU ( I Z , JZ ) 

>  ,ZMUT(IZ,JZ) 

>  , AREA( IZ) , ZMU( IZ, JZ) , Al( IZ, JZ) , A2( IZ, JZ) , A3( IZ, JZ) , A4( IZ, JZ) 
COMMON/CONST/A I N , ATH , RL , EX I , EY I , OMEGAX , OMEGAY , CEL , THETA , PO , TO , 

PRNT,PB,RM1, SUM(4) ,ZMUO,REN,PRN,TWALL,TREF,COND 
C0MM0N/C0NST1/CP(IZ, JZ) ,CV(rZ, JZ),GAMMA(IZ, JZ),GM1( IZ, JZ) ,RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV, ITIME, I  SUP, I VI  SC, IWALL 
DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ) ,RHOV( IZ , JZ ) , E ( I Z , JZ ) 
EgUIVALENCE(Q(l,l,l),RHO(l,l)), (Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(1,1,3),RH0V(1,1)), (Q(1,1,4),E(1,1)) 

,  ;■;**■>:*•*********************************************************** 

DIMENSION  D(4,4) 

CALL  SZER0(4,D) 

IF( IVISC.EQ.0)THEN 
R2MY=0. 

ELSE 

R2MY=4./3.*ZMU(I, J)/(Y(I, J)*Y(I, J)*RHO(I, J) ) 

END  IF 

D(3, 1)=.5*GM1(I, J)*(U( I, J)**2+V(I, J)**2)/Y(I, J)+IVISC*V(I, J)*R2MY 
D ( 3 , 2 ) =-GMl ( I , J ) *U ( I , J ) /Y ( I , J ) 

D(3, 3)=-GMl ( I, J)*V( I , J)/Y( I, J)-IVISC*R2MY 
D(3,4)-GM1(I, J)/Y(I, J) 

RETURN 

END 

SUBROUTINE  JACCAL 
C* 

C-  subroutine  for  JACOBIAN  METRIX 
C'  IF  IA=1,  ACAP  MATRIX 
C*  IF  IA=2,  BCAP  MATRIX 
C* 

Q***************************************************************** 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  { IZ=150, JZ=100 ) 

COMMON/VECTOR/DQ(IZ, JZ,4) ,Q(IZ, JZ,4) ,F( I Z , JZ , 4 ) , G( IZ , JZ , 4 ) , 

P(:Z, JZ) ,U( IZ, JZ),V(IZ, JZ) ,UN( IZ, JZ) , VN( IZ, JZ) 
COMMON/COORD/S A IX(IZ,JZ),SAIY(IZ,JZ), ETAX ( I Z , JZ ) , ET AY ( I Z , JZ ) 

>  ,RJ(IZ, JZ) ,X(IZ, JZ),Y(IZ, JZ) ,DELTAU( IZ, JZ) 
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-  ,ZMUT(IZ,JZ) 

''  ,  AREA(  IZ)  ,  ZMU(  IZ,  JZ  )  ,  A1  (  IZ,  JZ)  ,  A2  (  IZ,  JZ)  ,  A3  (  IZ,  JZ)  ,  A4(  IZ,  JZ) 
COMMON /CONST/A I N , ATH , RL , EX I , EY I , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 
PRNT,PB,RM1, SUM(4) , ZMUO, REN, PRN, TWALL, TREF, COND 
COMMON /CONST 1/CP ( IZ, JZ) ,CV( I Z , JZ ) , GAMMA ( IZ, JZ) , GMl ( IZ, JZ) , RGAS 
COMMON/INTFG/IL, JL, I  LI , JLl , NEND , NBEG, NADV , ITIME, ISUP, IVISC, IWALL 
DIMENSION  RHO( IZ, JZ) , RHOU( IZ, JZ) , RHOV( I Z , JZ ) , E ( I Z , JZ ) 
EQUIVALENCE(Q( 1, 1, 1) ,RHO( 1, 1) ) , ( Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

.  *J?Ih^;*h55?Ilhilhi?ihh*l;fihilL************ 

DIMENSION  A( 4, 4) , B(4, 4) ,C(4, 4) 

ENTRY  JACGB( lA, A, I , J) 

IF( lA. EQ. 2 )GO  TO  10 
CX=SAIX( I , J) 

CY=^SAIY{  I  ,  J) 

CONTRA=UN( I , J) 

GO  TO  20 
10  CX-=ETAX(  I  ,  J) 

CY=ETAY( I , J) 

CONTRA=VN( I , J) 

20  CONTINUE 

PHI2=0. 5D0*GM1 ( I , J ) * ( U ( I , J ) * *2 + V( I , J ) * *2 ) 

A(  1,  1)---0.0D0 
A(1,2)=CX 
A( 1, 3)=CY 
A(1,4)=0.D0 

A(2, 1 )=CX*PHI2-U( I , J)*CONTRA 
A(2,2)=CONTRA-(GAMMA( I, J)-2. )*CX*U(I, J) 

A(2,3)=CY*U(I, J)-GM1( I , J ) *CX*V ( I , J ) 

A(2,4)=GM1(I,J)*CX 

A(3, 1 )=CY*PHI2-V( I , J)*CONTRA 

A(3,2)=CX*V(I, J)-GM1(I, J)*CY*U(I, J) 

A(3, 3)=CONTRA-CY*V( I, J)*(GAMMA( I, J)-2. ) 

A(3,4)=GM1(I, J)*CY 

A(4, l)=CONTRA*(2 .D0*PHI2-GAMMA( I , J)*E( I , J)/RHO( I , J) ) 

A ( 4 , 2 ) =CX* ( GAMMA (I,J)*E(I,J) /RHO (I,J)-PHI2)-GM1(I,J)*  CONTRA*U ( I , J ) 
A ( 4 , 3 ) =C Y* ( GAMMA (I,J)*E(I,J) /RHO (I,J)-PHI2)-GM1(I,J) *CONTRA*  V ( I , J ) 
A ( 4 , 4 ) =GAMMA ( I , J ) *CONTRA 
RETURN 

*  VISCOUS  TERM  JACOBIAN  MATRIX 

* 

ENTRY  VJACOB(A,B,C, I, J) 

JP1=^J+1 

JM1=J-1 

ZMUP=0.5*(ZMU(I, J)+ZMU( I, JPl) ) 

ZMUM=0.5*(ZMU( I, J)+ZMU( I, JMl) ) 

YYP  =0.5*(Y(I, J)+Y(I, JPl)) 

YYM  ^-0.5*(Y(I,  J)+Y{I,  JMl)  ) 

YJP  =RJ(I, JP1)/Y(I, JPl) 

IF( JMl . EQ. 1 ) THEN 
Y  JM=:0 . 

ELSE 

YJM  =RJ( I, JM1)/Y(I, JMl) 

END  IF 
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IF(PRNT. EQ. O.DO)  THEN 

GAMP^O . 5* ( GAMMA( I , J ) +GAMMA( I , J+1 ) ) 

GAMM-0.5*(GAMMA( I, J)+CAMMA(I, J-1) ) 

GKCPP=ZMUP*GAMP/PRN 

GKCPM=ZMUM*GAMM/PRN 

EI.SE 

ZMUTP  ^  0.5*(ZMUT(I, JP1)+ZMUT(I,J)) 
ZMUTM  =  0.5*{ZMUT(I, JM1)+ZMUT(I, J) ) 
ZMULP  =  ZMUP  -  ZMUTP 
ZMULM  =  ZMUM  -  ZMUTM 
GAMP=0 . 5  * ( GAMMA ( I , J ) +GAMMA ( I , J+ 1 ) ) 
GAMM=0. 5* (GAMMA( I , J) +GAMMA( I , J-1 ) ) 
GKCPP  GAMP*(ZMULP/PRN  +  ZMUTP/PRNT) 
GKCFM  =  GAMM* (ZMULM/PRN+ZMUTM/PRNT) 
END  IF 

EXJ-ETAX( I , J)/RJ( I , J) 

E Y J=ETAY ( I , J ) /R J ( I , J ) 

ZMUU=ZMU( I , J) 

0R=1./RH0(I, J) 

0RP=1./RH0(I, JPl) 

0RM=1./RH0(I, JMl) 

ZMURP=ZMU( I , JPl ) *ORP 
ZMURM=2MU( I , JMl ) *ORM 
UR  =U(I, J)*OR 
URP=U( I , JPl )*ORP 
URM=U( I, JM1)*0RM 
VR  =V(I,J)*OR 
VRM=V(I, JM1)*0RM 
VRP^V( I , JPl )*ORP 
UMRP=URP*ZMU( I , JPl ) 

UMRM-URM*ZMU( I , JMl ) 

VMRP=VRP*ZMU( I . JPl ) 

VMRM=^VRM*ZMU(  I ,  JMl ) 

U2R  =UR*U(I,J) 

U2RP=URP*U( I, JPl) 

U2RM=URM*U(I, JMl) 

V2R  =VR*V(I,J) 

V2RP=VRP*V( I, JPl) 

V2RM=VRM*V(I, JMl) 

UVR  =UR*V(I,J) 

UVRP=URP*V(I, JPl) 

UVRM=URM*V(I, JMl) 

ER2  =E(I, J)*0R**2 

ER2P=E(I, JP1)*0RP**2 

ER2M=E( I, JM1)*0RM**2 

ZRYJP=2MURP*YJP 

ZRYJM=ZMURM*YJM 

ORYJP=ORP*YJP 

ORYJM=ORM*YJM 

VMRP=-2MURP*V( I , JPl ) *YJP 

VMRM=-ZMURM*V( I , JMl )*YJM 

URYJP=-URP*YJP 

URYJM=-URM*YJM 

VYJP=^2  .  *ZMU(  I ,  JPl )  *VRP*YJP 

VYJM=2 . *ZMU( I , JMl ) *VRM*YJM 
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V2YJP=-V2RP*2 . *ZMU( I , JPl ) *YJP 
V2YJM=-V2RM*2 . *ZMU( I , JMl ) *YJM 
UVYJP^-2 . *ZMU( I , JPl ) *UVRP*YJP 
UVYJM--2 . *ZMU( I , JM1)*UVRM*YJM 
VYJP2=VYJP*0. 5 
VYJM2=0. 5*VYJM 
UYJP-ZMU ( I , JPl ) *URP*YJP 
UYJM=2MJ( I , JMl ) *URM*YJM 
AAP1==  ZMUP*A1(  I  ,  J)*YYP 
AAP2=  ZMUP*A2( I , J)*YYP 
AAP3=  ZMUP*A3( I, J)*YYP 
AAP4-  GKCPP*A4( I , J)*YYP 
AAM1=  ZMUM*A1( I, JM1)*YYM 
AAM2-  ZMUM*A2n,3Ml)*YYM 
AAM3  =ZMUM*A3(I, JM1)*YYM 
AAM4  =GKCPM*A4( I, JM1)*YYM 
IL( JMl .EQ. 1 ) THEN 
CALL  SZERO( i, A) 

ELSE 

A(l,l)  -0. 

A(l,2)  =-0. 

A(l,3)  =0. 

A(l,4)  =0. 

A21=(  AAM1*'JRM'»-AAM2*VRM)*RJ(  I ,  JMl  )/Y(  I ,  JMl ) 

A (2,1)  =A21-1 ./3 . *EXJ*VMRM 

A( 2 , 2 )  =-AAMl*ORM*RJ ( I , JMl )/Y( I , JMl ) 

A ( 2 , 3 )  =- AAM2*0RM*RJ ( I , JMl ) /Y( I , JMl ) - 1 . /3 . *EXJ*ZRYJM 
A(2,4)  =0. 

A31=(AAM2*URM+AAM3*VRM)*RJ( I, JM1)/Y( I, JMl) 

A(3,l)  =A31+1./3.*ZMU(I, J) 

*  *EXJ*URYJM 

A( 3 , 2 )  =-AAM2*0RM*RJ ( I , JMl ) /Y( I ,  7M1 ) + 1 . /3 . *ZMU( I , J ) *EXJ*ORYJM 
A(3,3)  =-AAM3*0RM*RJ( I , JMl ) /Y( I , JMl ) 

A(3,4)  =0. 

A(4, 1 )  =( -AAM4*(-ER2M+U2RM+V2RM)+AAM1*U2RM+AAM3*V2RM+ 

+  2 . *AAM2*UVRM ) *RJ( I , JMl )/Y( I , JMl ) - 

+  1 . /3 . *EYJ*V2 Y JM- 1 . /3 . *EXJ*UVYJM 

A( 4, 2 )  =AAM4*URM*RJ( I , JMl )/Y( I , JMl ) -A2 1- 1 . /3 . *EXJ*VYJM2 
A ( 4 , 3 )  =AAM4*VRM*RJ ( I , JMl )/Y( I , JMl ) -A3 1- 1 . /3 . *EYJ*VYJM- 

*  1 ./3 . *EXJ*UYJM 

A(  4,  4  )  ■=-AAM4*0RM-^RJ(  I  ,  JMl  )/Y(  I  ,  JMl ) 

ENDIF 
C(l,l)  -0. 

C(l,2)  =0. 

C(l,3)  =0. 

C(l,4)  =0. 

C21=(AAP1*URP+AAP2*VRP)*RJ( I, JPl )/Y( I , JPl ) 

C(2,l)  =C21+1 ./3 . *EXJ*VMRP 

C(2, 2)  =-AAPl*ORP*RJ( 1, JP1)/Y( I, JPl) 

C ( 2 , 3 )  =-AAP2*ORP*RJ ( I , JPl )/Y( I , JPl ) + 1 . /3 . *EXJ*ZRYJP 
C(2,4)  =0. 

C31=(AAP2*URP+AAP3*VRP)*RJ( I, JP1)/Y( I , JPl) 

C(3,l)  =C31-1./3.*ZMU(I,J) 

*  *EXJ*URYJP 

C( 3 , 2 )  =-AAP2*0RP*RJ( I , JPl )/Y( I , JPl ) -1 . /3 • *ZMU( I , J ) *EXJ*ORYJP 
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I  ,  3  )  ^-AAP3*ORP*RJ{  I  ,  JPl  )/Y(  I ,  JPl ) 

.  .  <  ,  -1  )  =0. 

.  ..  :  -■( -AAP4*  ( -ER2P  +  U2RP  +  V2RP) +AAP]  *U2RP  +  AAP3*V2RP  + 

2 . -AAP2*UVRP ) *RJ( I , JPl )/Y( I , JPl ) + 

1  .  /3  .  *EYJ*V2Y.JP+1  ./3  •  *EXJ*UVYJP 
.  -■AAP4*URP*RJ(  I,  JP1)/Y{I,  JP1)-C21  +  1./3.*EXJ*VYJP2 
.  .  ,3}  -AAP4*VRP*RJ(  I,  JP1)/Y(I,  JP1)-C31H./3.*EYJ*VYJP  + 

1 . /3 . *EXJ*UYJP 

:  ,  .  :  ;  --AAP4*ORP*RJ( I, JP1)/Y(I, JPl) 

AAPl+AAMl 
;\AP2+AaM2 
AAP3+AAM3 
A...;  AAP4  +  AAM4 
i  ^  , 3 )  =0. 

1, .  ^  =-0. 

3 ;  !  "  i  ^-0. 

3  -  , 4)  -0. 

3  ,  :  -(  -/.A1*UR-AA2*VR)  *RJ(  I ,  J)/Y(  I ,  J  ) 

L  =aai*or*rj(  i ,  J)/Y(  i,.t) 

3)  -aA2*OR*RJ( I , J)/Y( I, J) 

[-•  ; ,  .*1  -0 . 

3  3,  1  )  -t(-AA2*UR-AA3*VR)*RJ(I,  J)/Y{I,  J) 

P  /2)  =AA2*0R*RJ(  I  ,  J)/Y(  I  ,  J) 

3  /  3 )  =AA3*0R*RJ(I, J)/Y( I, J) 

K  .  -1  )  =0  . 

A  1 )  =(AA4*(-ER2+U2R+V2R)-AA1*U2R-AA3*V2R- 
2. *AA2*HVR)*RJ(I, J)/Y(I, J) 

3  t,2 )  ^-AA4*UR*RJ(I, J)/Y(I, J)-B(2, 1) 

b  r , 3 )  =-AA4*VR*RJ( I , J)/Y( I , J)-B(3, 1) 

B(./4)  ---AA4*0R*RJ(I,  J)/Y(I,J) 
bb  aJF!I 
E . '!  '* 

,  ■  it  ^  r-ji!-k-k’k'k-k'k'k'k'k-k'k^^'k'k'k-k-/r’k-k-k’k-fcick'k'k'k'k'k'k'k'k'k-k-k'k’k-ir-k’k'k-k'k-k-k'k'k'fr'k 

■.■FJ'L  IME  FOR  COMPUTING  PRECONDITIONER 
:^RO•JTINE  PRECON(  I  ,  J,  A) 

k  *■  'K'k-k^^'k-k'k'kic'k'k'k-k-k'k^'fr-k'k-fr-k'k-k-k'k'k-kic'k'k'k'k-k'k-k'k'k-k'k'k-k'k'k-k'k'k'k-k-ir-k 

.'li  LICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( I Z=1 50 , JZ= 100 ) 

Cl  )MHON /VECTOR/DQ (IZ,JZ,4),Q(IZ,JZ,4),F(IZ,JZ,4),G(IZ,JZ,4), 

P(  IZ,  JZ)  ,  U( IZ, JZ) , V(IZ, JZ) ,UN( IZ, JZ) , VN( IZ, JZ) 

C  )[^iMON/COORD/SAIX(  IZ,  JZ)  ,  SAIY(  IZ,  JZ)  ,ETAX(  IZ,  JZ)  ,ETAY(  IZ,  JZ) 

,RJ(  IZ,.JZ)  ,X(  IZ,  JZ)  ,  Y(  IZ,  JZ)  ,DELTAU(  IZ,  JZ) 

, ZMUT( IZ, JZ) 

■  AREA( IZ) ,ZMU( IZ, JZ) ,A1( IZ, JZ) , A2( IZ, JZ) ,A3(IZ, JZ) ,A4(IZ, JZ) 

'  ■  MMON/CONST/A I N , ATH , RL , EX I , EYI , OMEGAX , OMEGAY , CEL , THETA , PO , TO , 
PRNT , PB , RMl , SUM ( 4  > , ZMUO , REN , PRN , TWALL , TREF , COND 
'  iMMON/CONSTl/CP ( I Z , JZ ) , CV ( I Z , JZ ) , GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV , ITIME, ISUP, IVISC, IWALL 
DIMENSION  RHO( IZ, JZ) ,RHOU( I Z, JZ ) , RHOV ( I Z , JZ ) ,E( IZ, JZ) 
EOUIVALENCE(Q( 1, 1, 1 ) , RHO( 1 , 1 ) ) , (Q( 1 , 1 , 2 ) , RHOU( 1 , 1) ) , 
(Q(l,l,3),RHOV(l,l)), (Q(1,1,4),E(1,  1) ) 

DIMENSION  A(4,4) 

k  Ar  k  k-tt-k  k-k-kit-kir-k'k^'kic'k'k'k-k^-k’k'kir-k-k’k'kie'k'k-k'k'kit'kir-k-k'k-k-k-k-k-k-k-k-k-k-k'k 

CALL  SZERO(4,A) 
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C0=DSQRT ( GAMMA (I,J)*P(I,J) /RHO( I , J ) ) 

2M-DSQRT(U( I, J)**2+V( I, J)**2)/CO 
I F(COND.GT. 0.0. AND.ZM.lt. 1.0)  GO  TO  100 
DO  1  MM=1,4 
1  A ( MM , MM ) = 1 . ODO 
RETURN 
100  CONTINUE 

ALPHA=U ( I , J ) *U ( I , J ) + V ( I , J ) * V ( I , J ) 

CON=CO*CO/ALPHA 
CONMl=CON-l . ODO 
A(l, 1)=1.0D0 
A(2, 2 )=1 . ODO 
A(3,3)=1.0D0 

A(4,  1  )-^0. 5DO*ALPHA*CONM1 

A(4, 2 )=-U( I , J)*C0NM1 

A(4, 3 )=-V( I , J)*C0NM1 

A(4, 4)-C0N 

RETURN 

END 

C - 

SUBROUTINE  EIGEN( lA, A, I , J ) 

C* 

C*  SUBROUTINE  FOR  EIGENVECTOR  MATRIX  CALCULATION 
C*  IF  IA=1  L  FOR  ACAP 
C*  IF  IA=2  L  FOR  BCAP 
C* 

Q************************* ****************************************** 

IMPLICIT  REAL*8(A-H,0-2) 

PARAMETER  ( IZ=150 , JZ=100 ) 

COMMON/VECTOR/DQ ( IZ.JZ,4),Q(IZ,JZ,4),F(IZ,JZ,4),G(IZ,JZ,4), 

P( IZ, JZ) ,U( IZ, JZ) ,V(IZ, JZ) ,UN(IZ, JZ) , VN( IZ, JZ) 
COMMON/COORD/SA IX(IZ,JZ),SAIY(IZ,JZ), ETAX ( I Z , JZ ) , ETAY ( I Z , JZ ) 

>  ,RJ( IZ, JZ) ,X( IZ, JZ),Y( IZ, JZ) ,DELTAU( IZ, JZ) 

>  ,ZMUT(I2,J2) 

>  , AREA( IZ) , 2MU( I Z , JZ ) , A1 ( I Z , JZ ) , A2 ( I Z, JZ ) , A3 ( I Z , JZ ) , A4 ( I Z , JZ ) 
COMMON /CONST/A I N , ATH , RL , EX I , EYI , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 

>  PRNT,PB,RM1, SUM(4) ,ZMUO,REN,PRN,TWALL,TREF,COND 
COMMON /CONST 1/CP ( I Z , JZ ) , CV ( I Z , JZ ) , GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV, ITIME, ISUP, IVISC, IWALL 
DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ),RHOV( I Z , JZ ) , E { IZ , JZ ) 
EQUIVALENCE{Q(1, 1, 1) ,RH0(1, 1) ), (Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) )  , 

<Q(1,1,3),RH0V(1,1)), (Q(1,1,4),E(1,1)) 
0********+********************************************************** 
DIMENSION  A(4,4),C(IZ, JZ) 

0*******+*********************************************************** 
CO^DSQRT ( GAMMA (I,J)*P(I,J) /RHO ( I , J ) ) 

C( I , J)=CO 

ZM=DSQRT(U(I, J)**2+V(I , J)**2)/C0 
C* 

IF(COND.GT. 0.0. AND.ZM.lt. 1.0)  GO  TO  500 
C* 

C*  EIGENVECTOR  FOR  ORIGINAL  EULER  EQN 
C* 

IF( lA . EQ. 2 )G0  TO  10 
CX^SAIX( I , J) 
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CY=SAIY( I , J) 

GO  TO  20 
10  CX=ETAX(I,J) 

CY=ETAY(I, J) 

20  CONTINUE 

SQ2=^DSQRT(2  -  DO) 

C  C=DSQRT(GAMMA(I, J)*P(I, J)/RHO(I, J) ) 

C1=CX/DSQRT(CX**2+CY**2 ) 

C2=CY/DSQRT(CX**2+CY**2 ) 

A(l, 1)=1. -0.5*GM1( I, J)*(U( I, J)**2+V(I, J)**2)/C0**2 
A(1,2)=GM1(I, J)*U(I, J)/C0**2 
A(1,3)=GM1(I, J)*V(I, J)/C0**2 
A(1,4)=-GM1(I, J)/C0**2 

A(2, 1)=(-C2*U(I, J)+C1*V(I, J) )/RHO( I, J) 

A(2,2)=C2/RHO(I, J) 

A(2,3)=-C1/RH0(I, J) 

A(2, 4)=0. 

A(3, 1 )=-(Cl*U( I , J)+C2*V( I , J) )/SQ2/RH0{ I , J)+ 

0.5/SQ2*GMl(I, J)*(U(I, J)**2+V(I, J)**2)/RH0(I, J)/CO 
A ( 3 , 2 ) =C1/SQ2/RH0 ( I , J ) -GMl ( I , J )/SQ2  *U ( I , J ) /RHO ( I , J ) /CO 
A ( 3 , 3 ) =C2 /SQ2/RH0 ( I , J ) -GMl ( I , J )/SQ2* V ( I , J ) /RHO ( I , J ) /CO 
A(3, 4)=GM1( I, J)/SQ2/RH0( I, J)/CO 

A(4,1)=(C1*U(I, J)+C2*V(I, J))/SQ2/RH0(I, J)+0.5/SQ2*GMl(I, J)* 
^  (U( I, J)**2+V(I, J)**2)/RH0(I, J)/CO 

A( 4, 2 )=-Cl/SQ2/RH0( I , J) -GM1( I , J)/SQ2*U( I , J)/RHO( I , J )/C0 
A(4,3)=-C2/SQ2/RHO(I, J)-GM1(I, J)/SQ2*V(I, J)/RHO(I, J)/CO 
A(4, 4)=GM1(I, J)/SQ2/RH0( I, J)/CO 
GOTO  600 
C 
C 

500  CONTINUE 
C* 

C*  EIGENVECTOR  FOR  PRECONDITIONED  EULER  EQN 

C'- 

IF(IA.EQ.2)  GO  TO  50 
IF(IA.NE.l)  STOP  999 
CX=SAIX(I, J) 

CY=SAIY(I, J) 

CONTRA=UN(I, J) 

GO  TO  60 
50  CX=ETAX(I,J) 

CY=ETAY(I, J) 

CONTRA=VN(I, J) 

60  CONTINUE 

UU=U( I , J)**2+V( I , J)**2 
XM=DSQRT ( UU/C ( I , J ) *  *  2 ) 

QM=1 .D0-XM**2 
XMM=QM**2 

AC=DSQRT ( CONTRA  *  *  2  *  XMM +4.D0*C(I,J)**2*XM**2 

>  *(CX**2+CY**2) ) 

A(l, 1)=0.5D0+0.5D0*(V( I, J)*CX-U(I, J)*CY)/(RHO(I, J)* 

>  (CX**2+CY**2) )-2 .DO*QM*CONTRA*^2/(XMM*CONTRA**2-AC**2) 

>  +GM1( I , J)*UU*(CX**2+CY**2)/(XMM*CONTRA**2-AC**2) 
A(l,2)=0.5D0*CY/(RHO(I, J)*(CX**2+CY**2) )+2.D0* 

>  CX*QM*CONTRA/(XMM*CONTRA**2-AC**2) 
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>  -GMl ( I , J)*U( I , J)*2 .DO* (CX**2+CY**2 )/(XMM*CONTRA**2-AC**2 ) 

A( 1 , 3 ) =-0 . 5D0*CX/( RHO( I , J ) * (CX**2+CY**2 ) ) +2 . DO*CY*QM*CONTRA 

-  /(XMM*CONTRA**2-AC**2 ) 

>  -GM1( I , J)*V( I , J)*2 .DO*(CX**2+CY**2)/(XMM*CONTRA**2-AC**2 ) 

A(l, 4)=2.D0*GM1( I, J)*(CX**2+CY**2)/(XMM*CONTRA**2-AC**2) 

A{2, 1)=0.5D0+0.5D0*(U(I, J)*CY-V(I, J)*CX)/(RHO(I, J) 

"  *(CX**2+CY**2) ) 

>  -2 .DO*QM*CONTRA**2/(XMM*CONTRA**2-AC**2) 

>  +GM1 ( I , J) *UU* (CX**2+CY**2 )/(XMM*CONTRA**2-AC**2 ) 

A ( 2 , 2 ) =-0 . 5D0*CY/ ( RHO ( I , J ) * ( CX**2+CY*  *2 ) ) +2 . DO*CX*QM*CONTRA/ 

>  (XMM*CONTRA**2-AC**2 ) 

>  -GM1( I, J)*U( I, J)*2.DO*(CX**2+CY**2)/(XMM*CONTRA**2-AC**2) 

A(2, 3)=0. 5DO*CX/(RHO( I, J)*(CX**2+CY**2) ) +2 . DO*CY*QM*CONTRA/ 

>  (XMiyi*CONTRA**2-AC**2  ) 

>  -GM1( I , J)*V( I , J)*2 .DO*(CX**2+CY**2)/(XMM*CONTRA**2-AC**2 ) 

A( 2 , 4)=2 . D0*GM1 ( I , J) * (CX**2+CY**2 )/(XMM*CONTRA**2-AC**2 ) 

A ( 3 , 1 )  =  ( ( QM*CONTRA+AC ) *C0NTRA-GM1 ( I , J ) *UU* ( CX*  *2  +CY*  *  2 ) ) 

>  /( AC* (QM* CONTRA- AC ) ) 

A(3,2)=(-CX*(QM*CONTRA+AC)+2.DO*GM1(I, J)*U(I, J)*(CX**2+CY**2) ) 

>  /(AC* (QM* CONTRA- AC) ) 

A(3, 3 )=(-CY*(QM*C0NTRA+AC)+2 .D0*GM1( I, J)*V( I , J) * (CX**2+CY**2 ) ) 

>  /( AC* (QM* CONTRA- AC ) ) 

A(3,4)=-2.D0*GM1(I, J)*(CX**2+CY**2)/(AC*(QM*C0NTRA-AC) ) 

A ( 4 , 1 )  =  ( CONTRA* ( QM*CONTRA- AC ) -GMl ( I , J ) *UU* ( CX*  *  2  +CY*  *  2 ) ) 

>  /(AC*(QM*CONTRA+AC) ) 

A(4,2)=(-CX*(QM*CONTRA-AC)+2.DO*GMl(I, J)*U(I, J)*(CX**2+CY**2) ) 

>  /(AC*(QM*CONTRA+AC) ) 

A ( 4 , 3 )  =  ( - ( QM*CONTRA- AC ) *CY+2 . D0*GM1 ( I , J ) * V( I , J ) * ( CX*  *2 +CY*  *2 ) ) 

>  /(AC*(QM*CONTRA+AC) ) 

A(4,4)=-2 .D0*GM1( I, J)*(CX**2+CY**2)/(AC*(QM*CONTRA+AC) ) 

600  CONTINUE 
RETURN 
END 

C - - - 

SUBROUTINE  COEFX(J) 

C* 

C*  .ciETTING  COEFFICIENTS  FOR  LX-OPERATOR 
C* 

(2*  "k  "k  ir  -k  ir  -k  ir  -k  ir  it  -k  ir  if  it  'k  it  -k  -k  if  -k  -k  i:  -k  -k  it  -k  ic  it  ic  ie  ic  -k  -k  ie  ic  -k  -k  -k  -k  -k  -k  -k  -k  ic  it  ir  -k  'k  -k  ir  "k  it  it  ir  -k  ir  ic  -k  -k  -k  -k 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( IZ=150, JZ=100) 

C0MM0N/VECT0R/DQ( IZ , JZ , 4 ) , Q( IZ, JZ, 4) , F( IZ,  JZ, 4 ) ,  G( IZ,  JZ,  4) , 

>  P( IZ, JZ) ,U( IZ, JZ) ,V( IZ, JZ),UN( IZ, JZ) , VN( IZ, JZ) 
COMMON/COORD/S A I X(IZ,JZ),SAIY(IZ,JZ), ETAX ( I Z , JZ ) , ETAY ( I Z , JZ ) 

>  , R J ( I Z , JZ ) , X ( I Z , JZ ) , Y ( I Z , JZ ) , DELTAU ( I Z , JZ ) 

>  ,ZMUT(IZ,JZ) 

>  , AREA( IZ) ,ZMU(IZ, JZ) , Al( IZ, JZ),A2(IZ, JZ) ,A3( IZ, JZ) , A4( IZ, JZ) 
COMMON/CONST/AIN, ATH, RL, EXI , EYI , OMEGAX , OMEGAY , CFL, THETA, PO, TO, 

>  PRNT , PB , RMl , SUM ( 4 ) , ZMUO , REN, PRN , TWALL , TREF , COND 
COMMON/CONST 1/CP ( I Z , JZ ) , CV ( I Z , JZ ) , GAMMA (IZ,JZ),GM1(IZ,JZ), RGAS 
COMMON/INTEG/IL, JL, ILl , JLl , NEND, NBEG, NADV, ITIME, ISUP, IVISC, IWALL 
DIMENSION  RHO( IZ, JZ) ,RHOU( IZ , JZ ) , RHOV( IZ , JZ ) , E ( I Z , JZ ) 
EQUIVALENCE(Q( 1, 1 , 1 ) , RHO( 1 , 1 ) ) , (Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(1,1,3),RH0V(1,1)), (Q(1,1,4),E(1,1)) 
0******************************************************************* 
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FI  FE  ; 


C 


DIMENSION  IN(4) ,EE(4,4, IZ) ,EL(4, IZ),W(4, IZ) 

DIMENSION  AM(4, 4)  ,  Biyi(  4,  4 )  ,  CM(  4, 4 )  ,  DM(  4 ) 

DIMENSION  AL(4, 4) ,BE(4) 

DIMENSION  A(4, 4) , AL1(4,4) ,D(4,4) 

DIMENSION  PA(4, 4) ,PPD(4,4) ,PINV(4,4),PRE(4,4) ,AL2(4,4) 
DIMENSION  AMI (4, 4) , BMl ( 4, 4) ,CM1{4, 4) , DM1 ( 4) , PIA( 4, 4) 
DIMENSION  El(4, 4) ,EINV(4, 4) ,AA(4, 4) ,GA(4, 4) ,GA1 ( 4, 4) , EG( 4, 4) 

-■  ,AINV(4,4) 

:-k-k-r-k-k-k'k-k-k-k-k'k: 


c* 

C-'  UF  ST  REAM  BOUNDARY  CONDITION  AT  1  =  1 
C* 

1=1 

TAUD=D£LTAU( I , o ) * THETA/EX I 
IF ( I  SUP. EQ. 3) GOTO  45 
CALL  SZERO(4,AM) 

CAuL  JACOB( 1, A, I , J) 

CALL  DHDQ(D, I,J) 

CALL  PRECON( I , J, PRE) 

CALL  EIGEN(1,AL1, I, J) 

DO  951  M=l,3 
DO  951  N=l,4 
951  AL] (M,N)=O.DO 
DO  901  MM=1,4 
DO  901  NN=1,4 

PPD ( MM , NN ) =PRE ( MM, NN ) -TAUD*D (MM, NN) 

901  CONTINUE 

CALL  INVER(4,PPD,PINV) 

CALL  MT'1M(4,  PINV,  A,PA) 

CALL  MMM(4, AL1,PA,PIA) 

CALL  SZERO(4,BM) 

DO  10  M=l, 4 
DO  10  M=l,4 

BM(M,N)=ALl(M,N)-TAirD*PIA(M,N) 

10  CONTINTJE 

RJYY=RJ( I, J)/Y(I, J) 

RCV=RHO(I, J)*CV(I,  J) 

RJRCV=RJYY/RCV 

BM(1,  1)  =  (-E(I,  J)/RHO(  I,vT)+GMl(I,  J)/GAMMA(I,  J)*(U(I,  J)**2 

>  +V(I, J)**2) )*RJRCV 

BM ( 1 , 2 ) =-GMl ( I , J ) /GAMMA ( I , J ) *U( I , J ) *RJRCV 
BM( 1 , 3 )=-GMl( I , J)/GAMMA( I , J ) *V( I , J ) *RJRCV 
BM( 1, 4)=RJRCV 

BM( 2 , 1 )=-GAMMA( I , J ) *E ( I , J)/RHO( I , J ) + ( GAMMA( I , J ) + 1 . ) *AAA 
BM(2,2)=-U(I, J) 

BM(2,3)=-V(I,  J) 

BM(2, 4)=1 .DO 

Cl=(RHO(I, J)*E(I, J)-0.5*RHO(I, J)**2*(U(I, J)**2+V(I, J)**2)  ) 
C2=(RHO(I, J)*E(I, J)-0.5*GM1(I, J)/GAMMA{I, J)*RHO(I, J)**2*(U(I , J)**2 
+V(I,J)**2)) 

C3=(C2/C1)**(GAMMA( I, J)/GM1( I, J) ) 

C4=GAMMA{I, J)/GM1(I, J)/C1*(C2/C1)**(1.D0/GM1(I, J)) 

BM(2, 1)=(0.5*(U(I, J)**2+V(I, J)**2)*C3+C4*E(I, J)*(C1-C2)/RH0( I, J) 

>  )*GM1(I, J)*RJYY 
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BM(2,2)=(-U(I, J)*C3+C4*U(I, J)*(C2-GM1(I, J)/GAMMA(I, J)*C1)) 

>  *GM1( I , J)*RJYy 

BM(2,3)-^(-V(I,  J)*C3+C4*V(I,  J)*(C2-GM1(I,  J)/GAMMA(I,  J)*C1)  ) 

>  *GM1(I, J)*RJYY 

BM(2,4)=(C3+C4*(C1-C2) ) *GM1 ( I , J) *RJYY 
EM  (  3 , 1 )  — -VN  (  I ,  J  )  ’^RJY 1/  RHO(  I ,  J  ) 

BM( 3 , 2 ) =ETAX( I , J ) *RJYY/RHO( I , J ) 

BM ( 3 , 3 ) =ETAY ( I , J ) *  R JYY/RHO ( I , J ) 

BM(3,4)=--0. 

CALL  SZERO(4,CM) 

CALL  JACOB(l,A, I+l, J) 

CALL  MMM(4,PINV, A,PA) 

CALL  MMM(4, AL1,PA,PIA) 

DO  20  M=l,4 
DO  20  N=l,4 
CM(M,N)=-TAUD*PIA(M,N) 

20  CONTINUE 

DO  971  M=l,3 
DO  971  N=l,4 
971  CM(M,N)=0.D0 
C* 

CALL  MMM(4, ALl, PINV, AL2 ) 

DO  952  M=l,4 
952  DM1(M)=DQ( I, J,M) 

CALL  MMV(4, AL2,DM1,DM) 

C* 

T0N=(E(I, J)/RHO(I, J)-0.5*GM1(I, J)/GAMMA(I, J)*(U(I, J)**2 

>  +V(I, J)**2) )/CV(I, J) 

TT  =(E( I, J)/RHO(I, J)-0.5*(U(I, J)**2+V(I, J)**2) )/CV(I, J) 
P0N=P{ I, J)*(T0N/TT)**(GAMMA( I, J)/GM1(I, J) ) 

DM(1)=  (TO-TON) 

DM(2)=  (PO-PON) 

DM(3)=  -VN(I,J) 

GOTO  49 

45  CONTINUE 

CALL  SZER0(4,AM) 

CALL  SZER0(4,BM) 

CALL  SZER0(4,CM) 

DO  46  M=l,4 
DM{M)=0. 

BM(M,M)=1.0 

46  CONTINUE 
49  CONTINUE 

CALL  EEL( 1,4, I L, EE , EL, AM, BM, CM, DM, IN, AL,BE) 

C* 

C*  INTERIOR  NODES 
C* 

DO  70  1=2, ILl 

TAUD=0 . 5D0*DELTAU( I , J ) *THETA/EXI 

TAUD2=2 . *TAUD 

IM1=I-1 

IP1=I+1 

CALL  PPECON(I, J,PRE) 

CALL  JAC0B(1,A, IMl, J) 

CALL  DHDQ(D, I, J) 
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DO  902  MM=1,4 
DO  902  NN=1,4 

PPD ( MM , NN ) =PRE ( MM , NN ) -TAUD2*D { MM, NN ) 
902  CONTINUE 

CALL  I NVER  (  L  ,  PPD ,  P I N'’’ ) 

CALL  MMM(4,PINV, A,PA) 

CALL  SMM(4,TAUD,PA, AM) 

CALL  SZER0(4,BM) 

DO  50  M=l,4 

50  BM(M,M)=BM(M,M)+1. 

CALL  JACOB(l,A, IPl, J) 

CALL  MMM(4,PINV, A,PA) 

CALL  SMM ( 4 , -TAUD , PA, CM ) 

DO  961  M=l,4 
961  DM1 {M)=DQ( I , J,M) 

CALL  MMV(4,PINV,DM1,DM) 


CALL  EEL(I,4, I L , EE , EL , AM, BM, CM, DM, IN, AL, BE ) 

70  CONTINUE 
* 

*  DOWNSTREAM  BOUDARY  CONDITION  AT  I=IL 

* 

I=--IL 

TAUD=-DELTAU(  I ,  J )  *THETA/EXI 
CALL  JACOB (1, A, I-l, J) 

CALL  DHDQ(D, I , J) 

CALL  PRECON( I , J, PRE) 

DO  903  MM=1,4 
DC)  903  NN=1,4 

PPD ( MM , NN ) =PRE ( MM , NN ) -TAUD*D ( MM , NN ) 

903  CONTINUE 

CALL  INVER(4,PPD,PINV) 

IF( ISUP. EQ. 1 .OR. ISUP.EQ. 3 )  GO  TO  75 
CALL  EIGEN(1,AL1, I, J) 

DO  71  N=l,4 

71  AL1(4,N)=0.0D0 

CALL  MMM(4, ALl, PA, AMI) 

CALL  SMM(4,TAUD, AMI, AM) 

CALL  JACOB (1, A, I, J) 

CALL  MMM{4,PINV,A,PA) 

DO  78  M^l,4 
DO  78  N=l,4 

78  A(M,N)=A(M,N)-D(M,N) 

CALL  MMM(4,AL1,PA,BM) 

DO  72  M==l,4 
DO  72  N=l,4 

72  BM(M,N)=BM(M,N)*TAUD+AL1(M,N) 

BM(4, 1)=0.5*(U(I, J)*U(I, J)+V(I, J)*V(I, J) ) 
BM(4,2)=-U(I, J) 

BM(4,3)=-V(I,  J) 

BM(4, 4)=1 . 

CALL  SZERO(4,CM) 

CALL  MMM(4,AL1,PINV,AL2) 

DO  73  M=l,4 
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DM(M)=0. 

DO  73  K=l,4 

73  DM(M)=DM(M)+AL2(M,K)*DQ( I , J,K) 

I F ( PB . NE . 0 . DO ) THEN 

DM(4)=  (PB-P( IL, J) )/GMl( IL, J)*Y( IL, J)/RJ( IL, J) 
ENDIF 
GO  TO  95 
75  CONTINUE 

CALL  MMM(4,PINV, A,PA) 

CALL  SMM(4,TAUD,PA,AM) 

CALL  JACOB(l,A, I, J) 

CALL  MMM(4,PINV,A,PA) 

CALL  SMM(4,TAUD,PA,BM) 

DO  80  M=l,4 
80  BM(M,M)=BM(M,M)+1 . 

CALL  SZER0(4,CM) 

DO  90  K=l,4 
90  DM1(K)=DQ(I, J,K) 

CALL  MMV(4,PINV,DM1,DM) 

95  CONTINUE 

CALL  EEL(I,4, IL, EE , EL , AM, BM, CM, DM, IN,AL,BE) 

C* 

C*  SOLVE  4*4  BLOCK  TRIDIAGONAL  SYSTEM 
C* 

CALL  SOLU(W, IL,4,EE,EL) 

DO  100  1=1, IL 
DO  100  K=l,4 
DQ(I, J,K)=W(K, I) 

100  CONTINUE 
C*  MULTI PY  DQ  BY  I-DT*D 
C  I2=IL 

C  IF(ISUP.EQ.0)I2=IL1 

C  DO  200  1=2, 12 

C  CALL  SZERO(4,BM) 

C  CALL  DHDQ(D, I, J) 

C  DO  120  M=l,4 

C  BM(M,M)=BM(M,M)+1.0 

C  DO  120  N=l,4 

C  BM{M,N)=BM{M,N)-DELTAU( I , J)*D(M,N) 

C  120  CONTINUE 
C  DO  140  K=l,4 

C  DM(K)=0. 

C  DO  140  N=l,4 

C  DM(K)=DM(K)+BM(K,N)*W(N, I ) 

C  140  CONTINUE 
C  DO  160  K=l,4 

C  160  DQ(I, J,K)=DM(K) 

C  200  CONTINUE 
RETURN 
END 

C - 

SUBROUTINE  COEFY(I) 

C* 

C*  SETTING  COEFFICIENTS  FOR  LY-OPERATOR 
C* 
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FILL:  AXI2DV 


-A’ ieic^ic'k'kic’k'k-k'k'k'k’kic'k'kiricie'ir'k-kkii-k'kicic-kieir'ki^ 


IMPLICIT  REAL*8( A-H, 0-Z) 

PARAMETER  ( I Z=150 , JZ-100 ) 

COMMON /VECTOR/nQ( I Z , JZ , 4 ) , Q( I Z , JZ , 4 ) , F ( I Z , JZ , 4 ) , G( I Z , JZ , 4 ) , 

P( IZ, JZ) ,U( IZ, JZ) , V( IZ, JZ) ,UN( IZ, JZ) , VN( IZ, JZ) 
COMMON/COORD/SAIX( IZ, JZ) , SAIY{ IZ, JZ) , ETAX( IZ, JZ) ,ETAY( IZ, JZ) 

,RJ( IZ, JZ) ,X( IZ, JZ) ,Y( IZ, JZ) ,DELTAU( IZ, JZ) 

,ZMUT(IZ,JZ) 

■  , AREA ( I Z ) , ZMU ( I Z , JZ ) , A 1 ( I Z , JZ ) , A2 ( I Z , JZ ) , A3 ( I Z , JZ ) , A4 ( I Z , JZ ) 
COMMON/CONST/AIN, ATH, RL, EXI , EYI , OMEGAX, OMEGAY, CFL, THETA, PO , TO , 
PRNT , PB , RMl , SUM ( 4 ) , ZMUO , REN, PRN , TWALL , TREF , COND 
COMMON/CONSTl/CP ( I Z , JZ ) , CV ( I Z , JZ ) , GAMMA { I Z , JZ ) , GMl ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, ILl , JLl , NEND, NEEG, NADV, ITIME, ISUP, IVISC, IWALL 
D I MENS  I ON  RHO ( I Z , JZ ) , RHOU ( I Z , JZ ) , RHOV (IZ,JZ),E{IZ,JZ) 
EQUIVALENCE(Q(1, 1, 1) ,RH0(1, 1) ) , (Q( 1 , 1 , 2 ) , RHOU( 1 , 1) ) , 

(Q(l, 1,3) ,RH0V(1,1)), (Q(l, 1,4) ,E(1, 1) ) 

DIMENSION  IN( 4) , EE(4, 4, JZ) ,EL(4, JZ) , W(4, JZ) 

DIMENSION  AM(4, 4) ,BM(4,4) ,CM(4,4) ,DM(4) 

DIMENSION  AL(4, 4) ,BE(4) 

DIMENSION  B(4,4) ,BL1(4,4) ,D(4,4),A(4,4) 

CHO 

DIMENSION  AMJL(4,4) ,BMJL(4,4) ,CMJL(4, 4) ,DMJL(4) 

DIMENSION  PINV(4,4) ,PPD(4,4) ,PRE(4,4) ,PINV1(4, 4 ) , PPDJLl ( 4 , 4 ) 

•  , PID(4,4) ,PIA(4, 4) ,PIB(4,4) ,DM1(4),DM2(4) ,DM10(4) ,DM20(4) 

C*  ON  THE  CENTER  LINE  OF  THE  NOZZLE  AT  J=1 

C* 

J=1 

CALL  SZER0{4,AM) 

CALL  SZER0(4,BM) 

DO  20  M=1 , 4 
DM(M)=0 . 

BM(M,M)=BM(M,M)+1.0 
20  CONTINUE 

CALL  SZER0(4,CM) 

CALL  EEL( J, 4, JL,EE,EL, AM,BM,CM,DM, IN, AL,BE) 


*  INTERIOR  NODS 

-k 

DO  80  J=2,JL1 

TAUD=0 . 5D0*DELTAU ( I , J ) *THETA/EYI 

TAUD2=2. *TAUD 

JMl-J-1 

JP1=J+1 

CALL  JAC0B(2,B, I , JMl) 

CALL  PREC0N( I , J,PRE) 

CALL  DHDQ(D, I, J) 

DO  904  MM=1,4 
DO  904  NN=1,4 

PPD(MM,NN)=PRE(MM,NN)-TAUD2*D{MM,NN) 
904  CONTINUE 

CALL  INVER(4,PPD,PINV) 

CALL  MMM(4,PINV,B,PIB) 
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CALL  SMM(4, TAUD, PIB, AM) 

CALL  SZER0(4,BM) 

DO  60  M=^l,4 
60  BM(M,M)=BM{M,M)+1 . 

CALL  JACOB ( 2, B, I , JPl ) 

CALL  MMM(4,PINV,B,PIB) 

CALL  SMM(4, -TAUD,PIB,CM) 

C* 

C*  INSERT  VISCOUS  JACOBIAN  LHS  HERE 
C* 

IF( IVISC. EQ. 1 ) THEN 
CALL  VJACOB(A,B,D, I, J) 

CALL  MMM(4,PINV,A,PIA) 

CALL  MMM(4,PINV,B,PIB) 

CALL  MMM(4,PINV,D,PID) 

DO  68  M=l,4 
DO  68  N=l,4 

AM(M,N)=AM(M,N)-DELTAU( I , J ) *PIA(M, N) 
BM(M,N)=BM(M,N)+DELTAU(I, J)*PIB(M,N) 

68  CM(M,N)=CM(M,N)-DELTAU( I , J)*PID(M,N) 

ELSE 
END  IF 
DO  70  K^l,4 
70  DM(K)=DQ( I , J,K) 

CALL  EEL( J, 4, JL,EE,EL, AM,BM,CM,DM, IN,AL,BE) 

80  CONTINUE 
C* 

C*  WALL  BOUNDARY  CONDITION 
C* 

CHOI  J=JL 

CHOI  TAUD=THETA*DELTAU( I , J)/Eyi 

CHOI  IF( IVISC. EQ. 1)G0T0  111 

CHO I  CALL  SZERO ( 4 , AM ) 

CHOI  CALL  JAC0B(2,B, I, J-1) 

CHOI  CALL  EIGEN(2,BL1, I, J) 

CHOI  DO  90  M=l,3 

CHOI  DO  90  N=l,4 

CHOI  DO  90  K=l,4 

CHOI  90  AM(M,N)=AM(M,N)+TAUD*BL1(M,K)*B(K,N) 

CHOI  CALL  SZERO(4,BM) 

CHOI  CALL.  JACOB(2,B,  I,  J) 

CHOI  CALL  DHDQ(D, I, J) 

CHOI  DO  100  M=l,3 

CHOI  DO  100  N=l,4 

CHOI  BM(M,N)=BM(M,N)+BL1(M,N) 

CHOI  DO  100  K=l,4 

CHOI  BM(M,N)=BM{M,N)+TAUD*BL1(M,K)*(B(K,N)-D(K,N) ) 

CHOI  100  CONTINUE 

CHOI 

CHOI 

J=JL 

TAUJL=DELTAU{ I , JL) 

TAUJM=DELTAU( I , JLl ) 

CALL  PRECON(I, JL1,PRE) 

CALL  DHDQ{D, I , JLl ) 
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DO  905  MM=1,4 
DO  905  NN=1,4 

PPDJL1(MM,NN)=PRE(MM,NN)-TAUJM*D(MM,NN) 

905  CONTINUE 

CALL  PRECON ( I, JL,PRE) 

CALL  DHDQ(D, I, JL) 

DO  906  MM=1,4 
DO  906  NN=1,4 

PPD ( MM , NN ) =PRE { MM , NN ) -TAU JL*D ( MM, NN ) 

906  CONTINUE 

IF( IVISC.EQ. 1)  GOTO  111 
CALL  SZERO(4, AMJL) 

CALL  JACOB(2,B, I, J-1) 

CALL  EIGEN(2,BL1, I, J) 

DO  1105  N=l,4 
BLl (4,N)=0.D0 
1105  CONTINUE 

DO  1101  M=l,4 
DO  1101  N=l,4 

AMJL(M,N)=-TAUJL*(PPDJLl(M,N)-2 .DO*TAUJM*B(M,N) ) 
1101  CONTINUE 

CALL  MMM(4,BL1, AMJL, AM) 

CALL  SZERO(4,BMJL) 

CALL  JACOB(2,B, I , J) 

DO  1201  M=l,4 
DO  1201  N=l,4 

BM JL ( M , N ) =TAU JM* ( PPD ( M , N ) +2 . D0*TAU JL*B ( M , N ) ) 

1201  CONTINUE 

CALL  MMM(4,BL1,BMJL,BM) 

CALL  SZERO(4,CM) 

DO  1501  MM=1,4 
DM1(MM)=DQ(I, JL,MM) 

1501  CONTINUE 

DO  1502  MM=1,4 
DM2(MM)=DQ{I, JL1,MM) 

1502  CONTINUE 

CALL  MMV(4,PPD,DM1,DM10) 

CALL  MMV(4,PPDJL1,DM2,DM20) 

DO  1300  M=l,4 

DM JL ( M ) =TAU JM*DM10 ( M ) +TAUJL*DM20 ( M ) 

1300  CONTINUE 

CALL  MMV(4,BL1,DMJL,DM) 

CHOI 

CHOI 

BM(4,1)=-VN(I, J) 

BM(4,2)=ETAX(I, J) 

BM(4,3)=ETAY(I, J) 

BM(4, 4)=0. 

CALL  SZERO(4,CM) 


CHOI 

DO  110  M=l,3 

CHOI 

DM(M)=0. 

CHOI 

DO  110  K=l,4 

CHOI 

DM(M)=DM(M)+BL1(M,K)*DQ(I, J,K) 

CHOI  110 

CONTINUE 

DM(4)=0. 
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GOTO  119 
111  CONTINUE 

CAIJ,  SZER0{4,AM) 

CALT,  SZER0(4,BM) 

CALL  SZER0(4,CM) 

DO  113  M=1 , 4 
DM(M)=0 . 

113  BM(M,M)=1.0 

119  CONTINUE 

CALL  EEL( J, 4, JL,EE,EL, AM,BM,CM,DM, IN,AL,BE) 

C* 

C*  SOLVE  4*4  BLOCK  TRIDIAGONAL  MATRICS 
C* 

CALL  SOLU(W, JL, 4, EE, EL) 

DO  120  J=1,JL 
DO  120  K^l, 4 
DQ(I, J,K)=W(K, J) 

120  CONTINUE 
RETURN 
END 

C - 

SUBROUTINE  FLUXCL 
C* 

C*  SUBROUTINE  FOR  FLUX  VECTOR  CALCULATION 
C* 

Q******************************************************************* 

IMPLICIT  REAL*8{A-H,0-Z) 

PARAMETER  ( I Z=150 , JZ=100 ) 

COMMON/VECTOR/DQ( IZ, JZ, 4) ,Q( IZ, JZ, 4) , F( IZ, JZ, 4) ,G( IZ, JZ, 4) , 

>  P( IZ, JZ) ,U( IZ, JZ) ,V(IZ, JZ) ,UN(IZ, JZ) ,VN( IZ, JZ) 
COMMON/COORD/SAIX( IZ, JZ) , SAIY( IZ, JZ) ,ETAX( IZ, JZ) ,ETAY( IZ, JZ) 

^  ,RJ(IZ, JZ) ,X(IZ, JZ),Y(IZ, JZ),DELTAU(IZ, JZ) 

>  ,ZMUT(I2,JZ) 

>  , AREA( IZ) ,ZMU( IZ, JZ) ,A1{ IZ, JZ) ,A2{IZ, JZ) ,A3( IZ, JZ) ,A4(IZ, JZ) 
COMMON/CONST/A I N , ATH , RL , EX I , EYI , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 

>  PRNT , PB , RM 1 , SUM ( 4 ) , ZMUO , REN , PRN , TWALL , TREF , COND 
COMMON/CONSTl/CP  (  I Z ,  JZ  )  ,  CV  (  I Z ,  JZ ) ,  GAMMA  ( I Z ,  JZ )  ,  GMl  (  I Z ,  JZ  )  ,  RGAS 
COMMON/INTEG/IL, JL, ILl , JLl , NEND, NBEG, NADV, ITIME, ISUP, IVISC, IWALL 
DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ) ,RHOV( IZ , JZ ) , E ( IZ , JZ ) 
EOUIVALENCE(Q( 1, 1, 1) ,RH0(1, 1) ), ( Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(1,1,3),RH0V(1,1)),(Q(1,1,4),E(1,1)) 

Q******************************************************************* 

ENTRY  FLUX 
C* 

C*  COMPUTE  CONVECTIVE  TERMS 
C* 

DO  10  1=1, IL 
DO  10  J=1,JL 

F( I, J, 1)=RH0(I, J)*UN(I, J)/RJ(I, J)*Y(I, J) 

F(I, J,2)=(RH0U( I, J)*UN( I, J)+SAIX(I, J)*P(I, J))/RJ(I, J)*Y(I, J) 

F(I, J,3)=(RH0V(I, J)*UN(I, J)+SAIY(I, J)*P(I, J) )/RJ(I, J)*Y(I, J) 

F(I, J,4)=(E(I, J)+P(I, J) )*UN(I, J)/RJ(I, J)*y(I, J) 

G ( I ,  J , 1 ) =RHO ( I , J ) * VN ( I , J ) /R J (I,J)*Y(I,J) 

G ( I , J , 2 )  =  ( RHOU ( I , J ) *  VN ( I , J ) +  ETAX (I,J)*P{I,J))/RJ(I,J)*Y(I,J) 

G(I, J,3)=(RH0V(I, J)*VN(I, J)+ETAY(I, J)*P(I, J) )/RJ( I , J ) *Y( I , J ) 
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C{ I , J,4)=(E(I, J)+P(I, J) )*VN(I, J)/RJ(I, J)*Y(I, J) 

lO  CONTINUE 
RETURN 

C*  VISCOUS  FLUX  VECTOR 

V... 

ENTRY  VFLUX 
DO  30  1=2, I L 
DO  30  J=2,JL1 
JF1=J+1 

ZMUP=0. 5* (ZMU( I , J)+ZMU( I , JPl ) ) 

ZMUM=0 . 5* ( ZMU( I , J ) +ZMU ( I , JMl ) ) 

IF(PRNT.EQ.O.DO)  THEN 

GAMP=0 . 5* (GAMMA( I , J) +GAMMA( I , JPl ) ) 

GAMM=0 . 5 * ( GAMMA ( I , J ) +GAMMA ( I , JMl ) ) 

GKCPP=ZMUP*GAMP/PRN 

GKCPM=ZMUM*GAMM/PRN 

ELSE 

ZMUTP  =  0.5*(ZMUT(I, JP1)+2MUT(I, J) ) 

ZMUTM  =  0.5*(ZMUT(I, JM1)+ZMUT(I,J)) 

ZMULP  =  ZMUP  -  ZMUTP 
ZMULM  =  ZMUM  -  ZMUTM 
GAMP=0 . 5* (GAMMA( I , J) +GAMMA( I , JPl ) ) 

GAMM=0 . 5* (GAMMA ( I , J ) +GAMMA( I , JMl ) ) 

GKCPP  =  GAMP*(ZMULP/PRN+ZMUTP/PRNT) 

GKCPM  =  GAMM*(ZMULM/PRN+ZMUTM/PRNT) 

END  I F 

YYP=0.5*(Y( I, J)+Y(I, JPl) ) 

YYM=0. 5*(Y( I , J)+Y( I, JMl) ) 

YZP=YYP*2MUP 
YZM=YYM*ZMUM 
AAP1=A1(I, J)*YZP 
AAM1=A1( I, JM1)*YZM 
AAP2=A2( I, J)*YZP 
AAM2=A2( I , JM1)*YZM 
AAP3=A3(I, J)*YZP 
AAM3=A3( I , JM1)*YZM 
AAP4=A4 ( I , J ) *YYP*GKCPP 
AAM4=A4 ( I , JMl ) * YYM*GKCPM 
UP=U( I , JP1)-U( I, J) 

UM=-U(I, JM1)+U(I, J) 

VP=V(I, JP1)-V(I, J) 

VM=V(I, J)-V(I, JMl) 

ERP=E( I, JP1)/RH0(I, JP1)-E(I, J)/RHO(I, J) 

ERM=E ( I , J ) /RH0( I , J ) -E ( I , JMl )/RHO ( I , JMl ) 

U2P=U( I, JP1)**2-U( I, J)**2 
U2M=U( I, J)**2-U(I, JM1)**2 
V2P=V( I, JP1)**2-V(I,  J)**2 
V2M=V(I, J)**2-V(I, JM1)**2 
UVP=U( I , JP1)*V( I, JP1)-U( I, J)*V(I, J) 

UVM=U( I , J ) *V( I , J ) -U( I , JMl ) *V( I , JMl ) 

G(I, J,1)=0. 

G( I , J,2)=(AAP1*UP-AAM1*UM)+(AAP2*VP-AAM2*VM) 

G( I , J,3)=(AAP2*UP-AAM2*UM)+(AAP3*VP-AAM3*VM) 

G( I , J,4)=(AAP4*ERP-AAM4*ERM)+0.5*( (AAP1-AAP4)*U2P- 


35 


on  Q  anna 


FILE:  AXI2DV 


FOR 


A1  VM/SP  CMS  4-8602  (02/02/88) 


THE  PENNSYLVANIA  STAT 


^  {AAMl-AAM4)*U2M) +0 . 5* ( ( AAP3-AAP4) *V2P- (AAM3-AAM4) *V2M) + 
( AAP2*UVP-AAM2*UVM) 

C* 

C*  INSERT  THE  EXTRA  FIRST  ORDER  TERMS  IN  CYLINDRICAL  COORDINATE 
C*  SYSTEMS 
C* 

EYJ-ETAY{ I , J)/RJ( I , J) 

EXJ=ETAX( I , J)/RJ( I , J) 

DMUV^O. 5* (ZMU( I , JPl )*V( I , JPl ) -ZMU{ I , JMl ) *V( I , JMl ) ) 

DDV  -0.5*(V(I, JP1)-V(I, JMl)) 

DMUV2^0. 5* (ZMU( I , JPl ) - V( I , JPl ) **2-ZMU( I . JMl ) *V( I , JMl ) **2 ) 
DM1JUV=0 . 5*  (  ZMU(  I ,  JPl )  *U(  I  ,  JPl )  *V(  I ,  JPl )  - 
*  ZMU( I , JMl )*U( I , JMl )*V( I , JMl ) ) 

DDU  -^0.5*(U(I,  JP1)-U(I,  JMl)) 

DDMU-0. 5*(ZMU( I , JPl ) -ZMU ( I , JMl ) ) 

G(I,J,2)=G(I,J,2)-2./3. *EX J*DMUV 

G ( I , J , 3 ) =G { I , J , 3 ) +2 . /3 . * ( ZMU ( I , J ) *EX J*DDU- V ( I , J ) *EY J*DDMU ) 
G( I , J, 4)=G( I , J, 4)-2 ./3 . * (EYJ*DMUV2+EXJ*DMUUV) 

30  CONTINUE 
RETURN 
END 


**  RIGHT  HAND  SIDE  CALCULATION 


SUBROUTINE  RHSCL 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  { I Z=150 , JZ=100 ) 

C0r.M0N/VECT0R/DQ(IZ,JZ,4),Q(IZ,JZ,4),F(IZ,JZ,4),G(IZ,JZ,4), 

>  P( IZ, JZ) ,U( IZ, JZ),V(IZ, JZ) ,UN( IZ, JZ) ,VN(IZ, JZ) 
C0MM0N./C00RD/SAIX(  IZ,  JZ)  ,  SAI Y ( IZ ,  JZ ) ,  ETAX (  IZ,  JZ)  ,ETAY(  IZ,  JZ) 

>  ,RJ( IZ, JZ) ,X(IZ, JZ),Y(IZ, JZ) ,DELTAU(IZ, JZ) 

>  ,ZMUT(IZ,JZ) 

>  ,AREA(  IZ),ZMU(IZ,  JZ),A1(IZ,JZ),A2(IZ,  JZ),A3(IZ,  JZ),A4(IZ,  '^Z) 
COMMON/CONST/ A I N , ATH , RL , EX I , EY I , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 

>  PRNT,PB,RM1, SUM(4) ,ZMUO,REN,PRN,TWALL,TREF,COND 
COMMON/'CONST  1/CP  (  I Z ,  JZ  )  ,  CV  ( I Z ,  JZ ) ,  GAMMA  (  I Z ,  JZ  )  ,  GMl  (  I Z ,  JZ )  ,  RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV, ITIME, ISUP, IVISC, IWALL 
DIMENSION  RHO( IZ, JZ) , RHOU( IZ, JZ),RHOV( I Z , JZ ) , E ( I Z , JZ ) 

EQUIVALENCE (Q( 1, 1,1), RHO( 1, 1) ) , (Q( 1, 1,2) ,RHOU( 1, 1) ) , 

>  (Q(l,l,3),RHOV(l,l)),(Q(l,l,4),E(l,l)) 

ENTRY  RHS 
CALL  FLUX 
EXI 1=2 . *EXI 
EYI I=EYI*2 . 

DO  10  1=1, IL 
DO  10  J=1,JL 
DO  10  K=1 , 4 
10  DQ(I,J,K)=0. 

1  =  1 

DO  30  J=1,JL 
DO  20  K=l,4 

20  DQ( I , J,K)=DQ{I, J,K)  +  (-3.*F( I, J,K)  +  4, *F( I  +  l,  J,K)- 

>  F( 1+2, J,K) )/EXII 
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20  Tv ( I , J, K)=DQ( I ,J,K)+(F(I+1,J,K)-F(I,J,K) )/EXI 
IF( 2.EQ. l.OR. J.EQ. JL)  GO  TO  30 

DO  25  K=l,4 

.;5  r  ;  ( I ,  j,k)=dq(  i  ,  j, k) +  (G(  i  ,  j+i,k)-g(  i  ,  j-i, k)  )/eyii 

3  0  C-'MTINUE 
1 

DO  50  1=1, I L 
DO  40  K=l,4 

u  10  Dt;(  I,  J,K)=DQ(I,  J,K)  +  {-3.*G(I,J,K)+4.*G(I,  J  +  1,K)- 
C  G(I, J+2,K) )/EY1I 

40  Dv,(  i  ,  J,K)=DQ(I,  J,K)  +  (G(I,  J+1,K)-G(I,  J,K)  )/EYI 
I F(  L . EQ. 1 .OR. I .EQ. IL)  GO  TO  50 
DC  45  K=l,4 

15  Da( I, J,K)=DQ(I, J,K)+(F(I+1, J,K)-F{I-1, J,K) )/EXII 

50  Coro.-INUE 
I  -- 1  r. 

DO  '^0  J=1,JL 
DC  60  K=l,4 

0  60  rO(I,  J,K)=DQ(I, J,K)  +  (F(I-2,J,K)-4.*F(I-1, J,K)  + 
r  3 . *F( I, J,K) )/EXII 

50  rc( i , J,K)-DQ( I, J,K)+(F(I, J,K)-F(I-1, J,K) )/EXI 
!;■  (  J.EQ.  l.OR.  J.EQ.  JL)  GO  TO  70 
D'j  65  K=l,4 

DC( I , J,K)=DQ(I, J,K)+(G(I, J+1,K)-G(I, J-1,K) )/EY!I 

70  CONTINUE 
J  =  TL 

DC  90  1=1, I L 
DO  80  K=l,4 

roD.  r 

80  DC( I , J,K)=DQ(I, J,K)+(G(I, J-2,K)-4.*G(I, J-1,K)+ 

3 . *G( I , J,K) )/EYII 

C  riC;  I  6 DQ  (  I  ,  J ,  K )  =DQ  (I,J,K)  +  (G(I,J,K)-G(I,J-1,K))  /E  Y I 
1  -  (  I  . EQ. 1 . OR. I . EQ. IL)  GO  TO  90 
DC'  85  K=l,4 

05  DQ( I , J,K)=DQ( I , J,K)+( F( I+l  J, K) -F( I - 1 , J, K) ) /EXI I 

90  CONTINUE 

DO  JOO  1=2  , I  LI 
DO  100  J=2,JL1 
IP1=I+1 
IMl-I-1 
JP1=J+1 
JMl  --Al-l 
DC  100  K=l,4 

DQ(  I  ,  J,  K)=DQ( I,J,K)  +  (F(IP1,J,K)-F( IMT, J,K) )/EXII  + 
(G( I , JP1,K)-G( I, JM1,K) )/EYII 

100  CufiTTNUE 

DO  200  1  =  1 ,  IL 
DO  200  J=2,JL 

DQ( I, J,3)=DQ(I, J,3)-P(I, J)/RJ(I, J) 

200  CONTINUE 
RETURN 

f-  VISCOUS  RIGHT  HAND  SIDE 

C 

EMl'RY  VRHS 
CALI.  VFLUX 
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DO  300  1=2 , IL 
DO  300  J=2,JL1 

DQ( I, J, 3)=DQ( I , J, 3)+4./3 . *ZMU{ I , J) *V( I , J )/ ( RJ ( I , J ) *Y( I , J ) ) 

DO  300  K=2,4 

300  DQ( I , J, K)=DQ( I , J , K ) -G ( I , J , K ) 

RETURN 

END 

Q  -k-k’k^it-k'k'k-k-k’k'k^-M-k'k'kiT'k-k’k'k'k'k'k-k’k'k'k'k'kic’k’k’k'ff'kie'k'k'k'k'k'ie'kie'k'kic'k'k'k'k'k'k'k'kic’kic'k'k 

C  SERVICE  SUBROUTINE 

Q  'k-kic-k-kie-i^-k-kyt-^^-k-k-k-k'k'k'k-k-k-fc'k-k’k-k'k-k-k'k-k'k'k'k'k-k'k'k'k'k'k-k-k'k'k'k'fcie'k'k'k'k'k'k-k'k-k'k'k'k'k'k'k 

SUBROUTINE  SUPPLY 
IMPLICIT  REAL*8{A-H,0-Z) 

PARAMETER  { I Z=150 , JZ=100 ) 

COMMON/VECTOR/DQ (IZ,JZ,4),Q(IZ,JZ,4),F(IZ,JZ,4),G(IZ,JZ,4), 

>  P( IZ, JZ) ,U( IZ, JZ) , V( IZ, JZ) ,UN( IZ, JZ) , VN( IZ, JZ) 
COMMON /COORD/SAIX( IZ, JZ) , SAIY( IZ, JZ) ,ETAX( IZ, JZ) ,ETAY( IZ, JZ) 

>  ,RJ( IZ, JZ) ,X( IZ, JZ) ,Y( IZ, JZ) ,DELTAU( IZ, JZ) 

"  ,ZMUT(IZ,JZ) 

^  , AREA ( I Z ) , ZMU ( I Z , JZ ) , A1 ( I Z , JZ ) , A2 { I Z , JZ ) , A3 ( I Z , JZ ) , A4 ( I Z , JZ ) 
COMMON/CONST/A I N , ATH , RL , EX I , EYI , OMEGAX, OMEGAY , CFL , THETA , PO , TO , 

>  PRNT,PB,RM1, SUM(4) , ZMUO, REN, PRN, TWALL, TREF, COND 
COMMON/CONST 1/CP ( I Z , JZ ) , CV ( I Z , JZ ) , GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV, ITIME, ISUP, IVISC, IWALL 
DIMENSION  RHO( IZ, JZ) , RHOU( IZ, JZ) ,RHOV( IZ, JZ ) , E ( I Z , JZ ) 

EQU I VALENCE ( Q( 1, 1, 1), RHO( 1, 1 )), (Q( 1,1,2 ),RHOU( 1,1)), 

>  (Q(1,1,3),RH0V(1,1)), (Q( 1,1,4), E( 1,1)) 
0******************************************************************* 

DIMENSION  SS(4) , SS1(4) ,SS2(4) 

ENTRY  CHECK 
DO  10  K=l,4 
SSI (K)=0.D0 
10  SS2(K)=O.DO 

IF ( IVISC. EQ. 1 ) THEN 

JEND=JL1 

ELSE 

JEND=JL 

END  IF 

IF( ISUP . Ef . 3 ) THEN 

IBEG=2 

ELSE 

IBEG=1 

END  IF 

DO  20  I=IBEG, IL 
DO  20  J=2,JEND 
DO  20  K=l, 4 
QQ=Q(I, J,K) 

C  IF(QQ. EQ. 0 . UO)GO  TO  20 

SS1(K)=SS1(K)+(DQ( I , J,K)*RJ( I , J)/Y( I, J) )**2 
SS2(K)=SS2(K)+QQ**2 
20  CONTINUE 

DO  30  K=l,4 

30  SS(K)=DSQRT(SS1(K)/SS2{K) ) 

WRITE(  19, 500)NADV,  (  SS  ( K )  ,  K=1 , 4 ) 

500  F0RMAT(I5,3X,4(1X,E14.7)) 

RETURN 
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FI  OF:  A 


F  I’FF  MASS 
F  ; ^ ■  ARCOS( -1 .DO) 
r-  80  1=1, IL 
E  ":'i=0. 

:  '  75  J=],JL1 

r  : R  DSQRT( (X(I, J+l)-X( I, J) )**2+(Y(I, J+1)-Y(I, J) )**2) 
C.\:;V  DSQRT(SAIX(  I,  J)**2  +  SAIY(I,  J)**2) 

C:.0Y1=DSQRT(SAIX(I,  J+1)**2+SAIY(I,  J+l)**2) 
r  :  -RT  =FLRT  +  0. 5*PPI*(Y(  I ,  J+ 1 ) +Y(  I ,  J )  )  *DELR 

*  (  RHO  (I,J+1)*UN(I,J^-1)  /CXCYl + RHO  (I,J)*UN(I,J)  /CXC  Y ) 
C  .  OFiNUE 

'•r;rTE(2  2,789)I,FLRT 

80  C':'l,TrNUE 

73^  I08i-.AT(  IX,  I8,E14.7) 

r  7TURM 

LOTRY  OUTPUT 
RiTE(22,550)NADV 

^  7 0  r  .F[  'AT  (  //lO  (  IH*  ) / '  NADV=  ’  ,  1 5// ) 

0  50  1  =  1,  IL 

r  '  50  J=1,JL 

r ;  i ,  j)/rho( i,  j)-gmi( i ,  j)*o.5/gamma( i ,  j)*(U( i,  j)**2+ 
V(I. J)**2))/CV(I, J) 

( E( I, J)/RH0( I, J)-0.5*(U( I, J)**2+V( I, J)**2) )/CV( I, J) 

I  'A-  :;)SQRT(  ( U(  I ,  J )  *U(  I ,  J  )  +  V(  I ,  J )  *V(  I ,  J )  )/GAMMA(I,  J) 

>  RHO( I, J)/P(I, J) ) 

;-F-r(  I,  J)*(ST/TT)**(GAMMA(I,  J)/GM1(I,  J)  ) 

1 0 ! TF ( 18 , 607 )X( I , J) , y ( I , J) , P( I , J) , RMA, TT, SP 
0PT'^E(66)  (Q(I,  J,K)  ,K=1,4),DELTAU(I,  J) 

607  :  .;RMAT(6(  1X,E14.7)  ) 

C  VPITEie,  600)1,  J,RH0(I,  J),U(I,  J),V(I,  J),E(I,  J),ST 
O  0R^TE(6, 650)P(I, J) ,UN(I, J) ,VN(I, J),SP,TT 
oOC  'RMAT(1X, '#' , 12, ' , ’ , 12 , 3X, 5 ( IX, ElO . 3 ) ) 

50  7  rMAT( lOX, 5( 1X,E10.3) ) 

0  oo.O'TINUE 

0  WRU  THE  LAST  TWO  LINES 

r-‘ 

i:o  55  1  =  116,117 
i;0  55  J=1,JL 

55  viRlTE(68)  (Q(I,  J,K),K=1,4) 

C 

RKTijRN 
Mi  ID 

C*  r  r  :  ARY  SUBROUTINES 

c* 

SUBROUTINE  EEL( J , MM, UMAX, E , EL, AM, BM, CM, DM, IN, AL,BE) 
IMPLICIT  REAL*8  (A-H,0-Z) 

DIMENSION  IN(MM) ,E(MM,MM, JMAX) ,EL(MM, JMAX) 

DIMENSION  AM(MM,MM) ,BM(MM,MM) ,CM{MM,MM) ,DM(MM) 

DIMENSION  AL(MM,MM) ,BE(MM) 

DO  30  M=1,MM 
IP  O.ODO 
DO  20  N=1,MM 
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T1=0.0D0 

IF( J.EQ. 1 )GO  TO  10 
TP^TP+AM(M,N)*EL(N, J-1) 

DO  6  K=1.MM 

5  T1=T1+AM(M,K)*E(K,N, J-1) 

10  CONTINUE 

AL(M,N)=BM(M,N)-T1 
20  CONTINUE 

EL(M, J)=DM{M)+TP 
30  CONTINUE 

DO  50  M=1,MM 
DO  40  N=1,MM 
40  E(M,N, J)=CM(M,N) 

50  CONTINUE 

CALL  AXB(MM,MM,AL,E(1, 1, J) ,BE,0, IN) 
CALL  AXB(MM, 1, AL,EL(1, J) ,BE, 1, IN) 
RETURN 
END 


SUBROUTINE  SOLU( W, UMAX, MM, E, EL) 

IMPLICIT  REAL*8(A-H,0-Z) 

DIMENSION  W(MM, JMAX) , E(MM,MM, UMAX) , EL(MM, UMAX) 

DO  40  M=1,MM 

W(M, JMAX)=EL(M, JMAX) 

40  CONTINUE 

DO  50  J1=2,JMAX 
J=JMAX+1-J1 
DO  46  M=1,MM 
SUM=0 . ODO 
DO  44  K=1,MM 

SUM=SUM+E(M,K, J)*W(K, J+1) 

44  CONTINUE 

W(M, J)=SUM+EL(M, J) 

46  CONTINUE 
50  CONTINUE 
RETURN 
END 


SUBROUTINE  AXB(N, M, A, B, X, INIT, IPS) 
IMPLICIT  REAL*8  (A-H,0-Z) 

DIMENSION  A(N,N),B(N,M), IPS(N) ,X(N) 
IF( INIT.EQ.O)CALL  DECOMP(N,A, IPS) 

DO  10  1=1, M 

CALL  SOLV(N, A,B( 1, I ) ,X, IPS) 

10  CONTINUE 
RETURN 
END 


SUBROUTINE  DECOMP(N, UL, IPS) 
IMPLICIT  REAL*8  (A-H,0-Z) 
DIMENSION  UL(N,N) , IPS(N) 

DO  5  1=1, N 
IPS( I )=I 
5  CONTINUE 
NM1=N-1 
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;  '.'DO 

L'  r:K,N 

;  .  .  OABS(UL( IP,K) ) 

•  AZE-BIG)11,  11,  10 

10  I.  ^0  OIZE 
0 ;  - 1 
i  I  C  .  V  A'JUE 

XPIV-K) 14, 15, 14 

i  i  1  :  D  (  K  ) 

A  : v)-IPS{ IDXPIV) 

-  li.)XPIV)=J 
IS  I  ^3(K) 

;  ■  J  -Ajr.(KP,K) 

:  S  ^  1 

I  I=KP1,N 

r ;  Xm IP,K)/PIV0T 
K)=-EM 

!.  J-^KP1,N 

:  r  J)=UL(  IP,  J)+EM*UL(KP,,  J) 

IS  f  :  V  ■  M'JE 
17  (■  ■A'  AMUE 
'■■•■/FIRN 
roD 


f  ;X'':-TINE  S0LV(N,UL,B,X,  IPS) 

.  ri.AriT  REAL*8  (A-H,0-Z) 

DlMK'flSION  UL(N,N)  ,B(N)  ,X(N)  ,  IPS(N) 

IS  I'-X+ 1 

n  “..a:.(1) 

:  ;  ^-8(1?) 
i.  2  I-2,N 
-  IP3(  I  ) 

.  :  '  'i  :  -  I  -  1 
SOI 2-0  .  ODO 
1  ,T=i,iMi 

1  SUil-:f--UH  +  UL(  IP,  J)*X(  J) 

2  Xf I )-B( IP)-SUM 
j  '-'-IPS(N) 

i..;;r)=x(N)/UL(  iP,N) 

Lo  4  IBACK=2,N 
l^XiPl  -  IBACK 
n -IPS( I  ) 

I  ■ '  1_  I  +  1 
SMS2--0  .  ODO 
DO  3  J=IP1,N 

3  S'P1-£'JM+UL(  IP,  J)*B(  J) 

4  P( 1 )={X( I )-SUM)/UL{ IP, I ) 

RETURN 

END 


C  EFI  ZERO  FOR  MATRIC  (M,M) 

SUfMoiUTINE  SZERO(M,A) 
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IMPLICIT  REAL*8(A-H,0-Z) 
DIMENSION  A(M,M) 

DO  10  1=1, M 
DO  10  J=1,M 
A( I , J)=0.0D0 
10  CONTINUE 
RETURN 
END 


C  SCALAR*METRIC  (M,M) 

SUBROUTINE  SMM(M,C,A,B) 
IMPLICIT  REAL*8(A-H,0-Z) 
DIMENSION  A(M,M),B(M,M) 
DO  10  1=1, M 
DO  10  J=1,M 
B(I, J)=C*A(I, J) 

10  CONTINUE 
RETURN 
END 


C  METRIX*METRIX  (M*M) 

SUBROUTINE  MMM(M,A,B,C) 

IMPLICIT  REAL*8(A-H,0-Z) 

DIMENSION  A(M,M) ,B(M,M) ,C(M,M) 

DO  10  1=1, M 
DO  10  J=1,M 
C( I, J)=0.0D0 
DO  10  K=1,M 

C(I,  J)=C(I, J)+A(I,K)*B(K, J) 

10  CONTINUE 
RETURN 
END 
C* 

SUBROUTINE  SyH( IL, lU, BB, DD, AA, CC) 

IMPLICIT  FZAL*8(A-H,0-Z) 

DIMENSION  AA(1) ,BB(1),CC(1),DD(1) 

C.  .  .  . 

C.  ...  SUBROUTINE  SYH  SOLVES  TRIDIAGONAL  SYSTEM  BY  ELIMINATION 

C....IL  =  SUBSCRIPT  OF  FIRST  EQUATION 

C....IU  =  SUBSCRIPT  OF  LAST  EQUATION 

C. . . .BB  =  COEFFICIENT  BEHIND  DIAGONAL 

C. . . .DD  =  COEFFICIENT  ON  DIAGONAL 

C. . . .AA  =  COEFFICIENT  AHEAD  OF  DIAGONAL 

C . . . . CC  =  ELEMENT  OF  CONSTANT  VECTOR 

C.  .  .  . 

C. . . .ESTABLISH  UPPER  TRIANGULAR  MATRIX 
C.  .  .  . 

LP  =  IL+1 
DO  10  I  =  LP, lU 
R  =  BB(I)/DD(I-1) 

DD(I)  =  DD(I)-R*AA(I-1) 

10  CC(I)  =  CC{ I )-R*CC( I-l) 

C.  .  . 

C...  BACK  SUBSTITUTION 
C.  .  . 
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CC(IU)  =  CC(IU)/DD(IU) 

DO  20  I  =LP, lU 
J  =  lU-I+IL 

20  CC(J)  =  (CC( J)-AA( J)*CC( J+1) )/DD( J) 

C.  .  . 

C...  SOLUTION  STORED  IN  CC 
C.  .  . 

RETURN 

END 

Q*****iIf****i*f**Tlf*:fc**************’***:ltr*****'fr***Slf*St*Tlf****Tllr****VfJt^*St** 

SUBROUTINE  INVER(M, A, AINV) 

IMPLICIT  REAL*8(A-H,0-Z) 

DIMENSION  A(4,4) ,B(4,4) ,AINV(4,4),COF(4,4) 

A11=A(1, 1) 

A12=A(1,2) 

A13=A(1,3) 

A14=A(1,4) 

A21=A(2, 1) 

A22=A{2,2) 

A23=A(2, 3) 

A24=A(2,4) 

A31=A(3, 1) 

A32=A(3,2) 

A33=A(3, 3) 

A34=A(3,4) 

A41=A(4, 1) 

A42=A(4,2) 

A43=A(4,3) 

A44=A(4,4) 

DET=A11*(A22*A33*A44+A23*A34*A42+A24*A43*A32-A24*A33*A42 

>  -A23*A32*A44-A22*A43*A34)- 

>  A12*{A21*A33*A44+A23*A34*A41+A24*A43*A31-A24*A33*A41 

>  -A23*A31*A44-A21*A43*A34)+ 

>  A13*{A21*A32*A44+A22*A34*A41+A24*A42*A31-A24*A32*A41 

>  -A22*A31*A44-A21*A42*A34)- 

>  A14*(A21*A32*A43+A22*A33*A41+A23*A42*A31-A23*A32*A41 

>  -A22*A31*A43-A21*A42*A33) 

COF(l, 1)=A22*A33*A44+A23*A34*A42+A24*A43*A32-A24*A33*A42 

>  -A23*A32*A44-A22*A43*A34 

COF( 1, 2 )=- ( A21*A33*A44+A23*A34*A41+A24*A43*A31-A24*A33*A41 

>  -A23*A31*A44-A21*A43*A34) 

COF(l,3)=A21*A32*A44+A22*A34*A41+A24*A42*A31-A24*A32*A41 

>  -A22*A31*A44-A21*A42*A34 

COF(l,4)=-(A21*A32*A43+A22*A33*A41+A23*A42*A31-A23*A32*A41 

>  -A22*A31*A43-A21*A42*A33) 

COF(2, 1)=-(A12*A33*A44+A13*A34*A42+A14*A32*A43-A14*A33*A42 

>  -A13*A32*A44-A12*A43*A34) 

COF(2,2)=All*A33*A44+A13*A34*A41+A14*A31*A43-A14*A33*A41 

>  -A13*A31*A44-A11*A43*A34 

COF(2,3)=-(All*A32*A44+A12*A34*A41+A14*A31*A42-A14*A32*A41 

>  -A12*A31*A44-A11*A42*A34) 

COF(2,4)=All*A32*A43+Al2*A33*A41+A13*A31*A42-A13*A32*A41 

>  -A12*A31*A43-A11*A42*A33 

COF(3, 1)=A12*A23*A44+A13*A24*A42■^A14*A22*A43-A14*A23*A42 

>  -A13*A22*A44-A12*A43*A24 
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COF( 3 , 2 )=- (A11*A23*A44+A13*A24*A41+A14*A21*A43-A14*A23*A41 

>  -A13*A21*A44-A11*A43*A24) 

COF( 3 , 3 )=A11*A22*A44+A12*A24*A41+A14*A21*A42-A14*A22*A41 

>  -A12*A21*A44-A11*A42*A24 

COF(3, 4)=-(All*A22*A43+A12*A23*A41+A13*A21*A42-A13*A22*A41 

>  -A12*A21*A43-A11*A42*A23 ) 

COF(4, 1 )=-(A12*A23*A34+A13*A24*A32+A14*A22*A33-A14*A23*A32 

>  -A13*A22*A34-A12*A33*A24) 

COF(4,2)=All*A23*A34+A13*A24*A31+A14*A21*A33-A14*A23*A31 

>  -A13*A21*A34-A11*A33*A24 

COF(4, 3)=-(All*A22*A34+A12*A24*A31+A14*A21*A32-A14*A22*A31 

>  -A12*A21*A34-A11*A32*A24) 

C0F(4, 4)=A11*A22*A33+A12*A23*A31+A13*A21*A32-A13*A22*A31 

>  -A12*A21*A33-A11*A32*A23 
AINV( 1, l)=COF(l, 1)/DET 
AINV(l,2)=COF(2, 1)/DET 
AINV( l,3)=COF(3, 1)/DET 
AINV( 1, 4)=COF(4, 1 )/DET 
AINV(2, l)=COF(l,2)/DET 
AINV(2,2)=COF(2,2)/DET 
AINV(2,3)=COF(3,2)/DET 
AINV(2,4)=COF(4,2)/DET 
AINV(3, l)=COF(l,3)/DET 
AINV(3,2)=COF(2,3)/DET 
AINV(3,3)=COF(3,3)/DET 
AINV(3,4)=COF(4,3)/DET 
AINV(4,l)=COF(l,4)/DET 
AINV ( 4 , 2 ) =COF ( 2 , 4 )/DET 
AINV(4,3)=COF(3,4)/DET 
AINV(4,4)=COF{4,4)/DET 
CALL  MMM(4, A, AINV,B) 

DO  1  MM=1,4 

WRITE(5,10)  (B(MM,NN) ,NN=1,4) 

1  CONTINUE 
10  FORMAT(4D16. 7) 

RETURN 
END 

Q**********+************************************************* 

SUBROUTINE  MMV(M,A,B,C) 

IMPLICIT  REAL*8(A-H,0-Z) 

DIMENSION  A(M,M) ,B(M) ,C(M) 

DO  10  1=1, M 
C( I )=0.D0 
DO  10  K=1,M 
C(I)=C(I)+A(I,K)*B(K) 

10  CONTINUE 
RETURN 
END 

C*  ************************************************************* 

SUBROUTINE  CPGAM( CP , CV , GAMMA, GMl , R, I, J, 

>  RHO,RHOU,RHOV,E,TCP) 

Q******************************************************************* 

PARAMETER ( IZ=150, JZ=100 ) 

IMPLICIT  REAL*8  (A-H,0-Z) 

COMMON/CPCOFF/  CPAl , CPA2 , CPA3 . CPA4 , CPAS , CPA6 , CPA7 
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>  ,CPA8,CPA9,CPA10,ENE(101) 

0========= 

IF(TCP.NE.O.O)  GOTO  20 

UU=RHOU/RHO 

VV=RHOV/RHO 

EE=E/RHO-  0 . 5  *  ( UU*  *  2 + W*  *  2  ) 

TT=300. 0 

IF(EE.LE.ENE(1) )  GO  TO  20 
DO  10  MM=1,101 
EA=  EE  -  ENE(MM) 

EB=  EE  -  ENE(MM+1) 

ESIGN=  EA*EB 
IF(ESIGN.LE.O.DO)THEN 

Tl=300 . 0+27 . 611*DFL0AT(MM-1 ) 

T2=300 . 0+27 . 611*DFL0AT(MM) 

TT=(T2*EA-T1*EB)/(EA-EB) 

GO  TO  20 
ELSE 
END  IF 

10  CONTINUE 

TT=3061 . IDO 
20  CONTINUE 

IF(TCP.NE.O.O)  TT=TCP 
C* 

IF(TT.LE.1000.0)THEN 

CP=(CPA6+CPA7*TT+CPA8*TT**2+CPA9*TT**3+CPA10*TT**4) 

CV=CP-R 

ELSE 

CP= ( CPAl +CPA2  *TT+CPA3  *TT*  *2  +CPA4*TT*  *  3  +CPA5*TT*  *  4 ) 
CV=CP-R 
END  IF 
GAMMA=CP/CV 
GM1=GAMMA-1.0 
RETURN 
END 

(^•k  ic  -k  -k  -k  ic  :k  -k  -k  'k  "k  -k  "k  ie  "k 

SUBROUTINE  CPCOEF 

C* ************** 

IMPLICIT  REAL*8  (A-H,0-Z) 

COMMON/CPCOFF/  CPAl , CPA2 , CPAS , CPA4, CPAS , CPA6 , CPA7 

>  ,CPA8,CPA9,CPA10,ENE(101) 

DIMENSION  Y(10) ,A1(10) ,A2(10),A3(10) , A4(10) ,A5(10) 

>  ,A6(10) ,A7(10) ,A8(10),A9(10),A10(10),WM(10) 
DATA  RU,WMMIX/8314.3,20.405/ 


CO 

WM(1)=28.010 
Y(l)=  0.13108 

C  C02 

WM(2)=44.0 
Y(2)=  0.03636 

C  H 

WM(3)=1.0 
Y(3)=  0.02387 

C  H2 
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WM(4)=2 .0 
y(4)^  0.15802 

C  H20 

WM(5)=18.0 
Y(5)=  0.32366 

C  NO 

WM(6)=30.0 
Y(6)=  0.00260 

C  N2 

WM( 7)=28 . 0 
Y(7)=  0.30407 

C  0 

WM(8)=16. 0 
y(8)=  0.00158 

C  OH 

WM(9)=17.0 
Y(9)=  0.01744 

C  02 

WM(10)=32 .0 
Y(10)=  0.00129 

C . . - . . CO 

Al(l)=  0.29840696E+01 
A2(l)=  0. 14a91390E-02 
A3 ( 1 )=-0 . 57899684E-06 
A4{1)=  0. 10364577E-09 
A5(1)=-0.69353550E-14 
C 

A6(l)=  0.37100928E+01 
A7(l)=-0. 16190g64E-02 
A8(  I)=  0.36923594E-05 
A9( l)=-0.20319674E-08 
A10(l)=  0.23953344E-12 

C . - . . C02 

Al(2)=  0. 44608041E+01 
A2{2)-  0. 30981719E-02 
A3(2)=-0. 12392571E-05 
A4(2)=  0.22741325E-09 
A5(2 )=-0. 15525954E-13 
C 

A6(2)=  0.24007797E+01 
Al{2)=  0.87350957E-02 
A8(2)=-0. 66070878E-05 
A9(2)=  0.20021861E-08 
A10(2)=  0. 63274039E-15 

C - - - H 

Al(3)=  0. 25000000E+01 
A2(3)=  0.00000000 
A3(3)=  0.00000000 
A4(3)=  0.00000000 
A5(3)=  0.00000000 

c 

A6(3)^  0.25000000E+01 
A7(3)=  0.00000000 
A8(3)=  0.00000000 
A9(3)-  0.00000000 
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A10(3)=  0.00000000 

C - H2 

Al(4)=  0. 30558123E+01 
A2(4)=  0. 59740400E-03 
A3 (4)=-0. 1674747 lE-08 
A4(4)  — 0.21247544E-10 
A5(4)=  0.25195487E-14 
C 

A6(4)=  0.29432327E+01 
A7(4)=  0. 34815509E-02 
A8(4)=-0. 77713819E-05 
A9(4)=  0. 74997496E-08 
A10(4):^-0.25203379E-11 

C - H20 

Al(5)=  0.26340654E+01 
A2(5)=  0.31121899E-02 
A3  ( 5 ) =-0 . 90278449E-06 
A4(5)=^  0. 12673054E-09 
A5(5)=-0.69164732E-14 
C 

A6(5)=  0. 41675564E+01 
A7(5)=-0. 18106868E-02 
A8(5)=  0. 59450878E-05 
A9(5)=-0.48670871E-08 
A10(5)=  0. 15284144E-11 

C . . . NO 

Al(6)=  0.31486543E+01 
A2(6)=  0. 14151823E-02 
A3(6)=-0.57574881E-06 
A4(6)=  0. 10738529E-09 
A5( 6)=-0. 73900199E-14 
C 

A6(6)=  0.42484931E+01 
A7(6)=-0. 48661106E-02 
AS(6)=  0. 11634155E-04 
A9 ( 6 ) =-0 . 99768494E-08 
A10(6)=  0.30483948E-11 

C - - ---N2 

Al(7)=  0.28536374E+01 
A2(7)=  0. 16014368E-02 
A3(7)=-0. 62888336E-06 
A4(7)=  0. 11428932E-09 
A5(7)=-0. 77953822E-14 
C 

A6(7)=  0.37034288E+01 
A7( 7)=-0. 14179405E-02 
A8(7)=  0.28625094E-05 
A9(7)=-0. 12018374E-08 
A10(7)=-0. 13475522E-13 

C - - - 0 

Al(8)=  0.25342961E+01 
A2(8)=-0. 12478170E-04 
A3(8)=-0. 12562724E-07 
A4(8)=  0.69029862E-11 
A5(8)=-0.63797095E-15 
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C 

A6(8)=  0. 30309401E+01 
A7(8)=-0.22525853E-02 
A8(8)=  C.39824540E-05 
A9( 8 )=-0. 3260492 lE-08 
A10(8)=  0. 10152035E-11 

C - OH 

Al(9)=  0. 28897814E+01 
A2(9)=  0. 10005879E-02 
A3(9)=-0.22048807E-06 
A4(9)=  0.20191288E-10 
A5(9)=-0. 39409831E-15 
C 

A6(9)=  0.38737300E+-01 
A7(9)=-0. 13393772E-02 
A8(9)=  0. 16348351E-05 
A9(9)=-0. 52133639E-09 
A10(9)=  0. 41826974E-13 

C - 02 

Al{10)=  0.36122139E+01 
A2(10)=  0. 74853166E-03 
A3(10)=-0. 19820647E-06 
A4(10)=  0.33749008E-10 
A5(10)=-0.23907374E-14 
C 

A6{10)=  0. 37837135E+01 
A7(10)=-0.30233634E-02 
A8(10)=  0.99492751E-05 
A9(10)=-0.98189101E-08 
A10(10)=  0.33031825E-11 
0================================= 

CP A 1=0. DO 

CPA2=0.D0 

CPA3=0.D0 

CPA4=0.D0 

CPA5=0.D0 

CPA6=0.D0 

CPA7=0.D0 

CPA8=0.D0 

CPA9=0.D0 

CPA10=0.D0 

DO  10  J=l,10 

CPA1=CPA1+Y( J ) *A1 ( J ) *RU/WMMIX 
CPA2=CPA2+Y( J ) *A2 ( J ) *RU/WMMIX 
CPA3=CPA3  +Y( J ) *A3 ( J ) *RU/WMMIX 
CPA4=CPA4+ Y ( J ) * A4 ( J ) *RU/WMMIX 
CPA5=CPA5+Y( J ) *A5 ( J ) *RU/WMMIX 
CPA6=CPA6+Y ( J ) *A6 ( J ) *RU/WMMIX 
CPA7=CPA7+Y ( J ) *A7 { J ) *RU/WMMIX 
CPA8=CPA8+Y( J ) *A8 ( J ) *RU/WMMIX 
CPA9=CPA9  +Y ( J ) * A9 ( J ) *RU/WMMIX 
CPA10=CPA10+Y( J ) *A10 ( J ) *RU/WMMIX 
10  CONTINUE 
C.  .  . 

R=RU/WMMIX 
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DO  20  MM=1, 101 

TT=300 . 0+27 . 611*DFL0AT(MM-1 ) 

IF(TT. LE. 1000.0)THEN 

CP^ (CPA6+CPA7*TT+CPA8*TT**2+CPA9*TT**3+CPA10*TT**4) 

CV=CP-R 

ENE{MM)=CV*TT 

ELSE 

CP^(CPA1+CPA2*TT+CPA3*TT**2+CPA4*TT**3+CPA5*TT**4) 

CV=CP-R 
ENE(MM)=CV*TT 
END  IF 

20  CONTINUE 
RETURN 
END 

//DATA. INPUT  DD  * 

<&INPUT  IL=125, JL=80,NBEG=1,NEND=30,NITER=30,P0=1.D+06,T0=3061. IDO, 
CFL=5.0,  OMEGAX=0.25,OMEGAY=0.25,RM1=0.04,  RM2=1 . 2 , I SUP=1 , 
AIN=1.0,  ATH=0.8,  RL=1.3,  THETA=1 . 0, CP0=7152 . 4853 , GAMMA0=1 . 17 , 
I T I ME=1 , I READ=1 , FST=0 . 00 , TWALL=3512 . 07 , FSTY=0 . 9 , PB=0 . , 

I V I SC= 1 , I WALL=0 , PRN=0 . 7 , REN=1 . D5 , TREF=3  000 . , ZMU0=0 . DO , 
PRNT=0.7D0,  COND=0.0, 

&END 

//DATA. FT38F001  DD  DSN=STU. I 19500 . MYHIOO . HERMES . CONV . H125M80 . VI S , 

//  DISP=(OLD,KEEP),VOL=REF=STU. 119500. MYHIOO. LIB, 

//  DCB^--(RECFM=VBS,LRECL=80,BLKSIZE=3120)  , 

//  SPACE=(TRK, (9, 5) ,RLSE) 

//DATA. FT66F001  DD  DSN=STU . I 19500 .MYHIOO . HERMES . CONV . RERUN . VI S , 

//  DISP=(NEW, KEEP) ,V0L=REF=STU. 119500. MYHIOO. LIB, 

,-'/  DCB=  (  RECFK=VBS ,  LRECL=80 ,  BLKSIZE=3 120 ) , 

//  SPACE=(TRK, (9, 5) ,RLSE) 

//DATA.FT19F001  DD  DSN=STU . I 19500 . MYHIOO . HERMES . CONV . DQ . VI S , 

//  DI SP=( NEW, KEEP ) ,V0L=REF=STU. 119500 . MYHIOO . LIB , 

//  DCB=( RECFM=FB, LRECL=80,BLKSIZE=3120) , 

//  SPACE=(TRK, (9,5) ,RLSE) 

//DATA. FT18F001  DD  DSN=STU . I 19500 .MYHIOO . HERMES . CONV . SOLU . VI S , 

//  DISP=(NEW,KEEP) , VOL=REF=STU. I 19500 . MYHIOO . LIB , 

//  DCB=(RECFM=FB, LRECL=130, BLKSIZE=3120) , 

//  SPACE=(TRK, (9, 5) ,RLSE) 

//DATA. FT22F001  DD  DSN=STU. I 19500 . MYHIOO . HERMES . CONV . MASS . VIS , 

//  DISP=(NEW,KEEP) , VOL=REF=STU. I 19500 . MYHIOO . LIB, 

//  DCB=(RECFM=FB,LRECL=130,BLKSIZE=3120) , 

//  SPACE=(TRK, (9,5) ,RLSE) 

//DATA. FT68F001  DD  DSN=STU . I 19500 . MYHIOO . HERMES . CONV . LINE . VI S , 

//  DISP=(NEW,KEEP) ,VOL=REF=STU. I 19500 . MYHIOO . LIB, 

//  DCB=^(RECFM=VBS,LRECL=80,BLKSIZE=3120)  , 

//  SPACE=(TRK, (9, 5) ,RLSE) 

//  EXEC  PROMPTME 
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VENKATESWARAN  SANKA  (V19) 


PNSVIS  FOR 


X14140 

USERID:  T19 

ORIGIN:  PSUVM 

CREATED : 

06/20/89 

FILENAME  VNSVIS 

FOR 

CLASS;  A 

FORMAT: J 

SPOOL  ID: 

RECS:  3011 

COPY;  1 

DUPLICATE: 

PRINTED  AT-  PSUVM  ID:  $PPCBP01  AT:  06/20/89  15:42:54 

*******  ^-^  ^ .  ******************-*■******************************** 

* 

*  THIS  i  ll...  WAS  SENT  BY  THE  COMMAND: 

*  PRT3ai>  TMSVIS  FOR  A1  (  PPCBl  COPIES  1  ORIENT  N  FONT  11 

* 

*  ;•  *  *  *  *  ~  v  .'*************************************************'* 
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//STIXXXXX  JOB 
/*JP  T=500,  L=10000 
//  EXEC  PGM=IEFBR14 

//* 

//D  DD  VOL=REF=STU. 119500. MYHIOO. LIB, DISP=(OLD, DELETE), 

//  DSN=STU.  I19500.iyiYH100.HERMES2.DIF.SOLU.VIS 
//  EXEC  FVCG , PARM . SOURCE- ' OPT ( 3 ) * 

//*  EXEC  FWCG 
//SYS IN  DD  * 

C  THIS  VERSION  USES  TRUE  JACOBIAN 

Q******:*r***************************^f**************3t******** 

C*  PROGRAM  NAME;  NOZZLE  * 

C*  AX I SYMMETRIC  SUPERSONIC  NOZZLE  FLOW  * 

C*  IN  GENERAL  COORDINATE  SYSTEM  * 

C*  USING  TIME  ITERATIVE  UW/CD  DDADI  METHOD  * 

C*  WITH  THIN-LAYER  APPROXIMATED  NAVIER-STOKE ' S  EQ.  * 

Q********************************************************** 

c* 

C*  MAIN  PROGRAM 
C* 

C* ****************************************************************** 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( IZ=150, JZ=30 ) 

COMMON/VECTOR/DQ(IZ, JZ,4) , Q( IZ, JZ, 4) , F( IZ , JZ, 4) , G( IZ, JZ , 4) , 

>  P(IZ, JZ) ,U(IZ, JZ),V(IZ, JZ) ,UN(IZ, JZ),VN(IZ, JZ) 
COMMON/COORD/S AIX ( I Z , JZ ) , SAI Y( I Z , JZ ) , ETAX ( I Z , JZ ) , ETAY ( I Z , JZ ) 

>  ,ZMUT(JZ) ,RJ(IZ, JZ) ,X(IZ, JZ),Y(IZ, JZ) ,DELTAU(IZ, JZ) 

>  ,AREA(IZ),ZMU(IZ, JZ),A1(IZ, JZ),A2(IZ, JZ),A3(IZ, JZ),A4(IZ, JZ) 
COMMON/CONST/AIN, AEX, RL, EXI , EYI , OMEGAX, OMEGAY , CFL , THETA , PO, TO, 

>CFL1 , PRNT , PB , RMl , SUM( 4 ) , ZMUO , REN, PRN, TWALL , TREF 
>,BI0T,TW1 

COMMON/CONSTl/GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , CP ( I Z , JZ ) , CV ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, ILl, JL1,NEND,NBEG,NADV, ITIME, IVISC,N0RD, IWALL 

>  ,IWBC,IFLOW 

DIMENSION  RH0(IZ, JZ) ,RHOU(IZ, JZ),RH0V(IZ, JZ) ,E(IZ, JZ) 
EQUIVALENCE(Q(1,1,1),RH0(1,1)), (Q(1,1,2),RH0U(1,1)), 

>  (Q(1,1,3),RH0V(1,1)), (Q(1,1,4),E(1,1)) 

Q*************** ****************** ********************************** 

CALL  INITIA 
DO  10  NADV=NBEG,NEND 
CALL  SOLVE 
CALL  CHECK 
10  CONTINUE 
CALL  MASS 
CALL  OUTPUT 
STOP 
END 
C* 

C*  SET  UP  INITIAL  CONDITION 
C* 

SUBROUTINE  INITIA 

C* ******************************************  ************************* 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( IZ=150 , JZ=80 ) 

COMMON/VECTOR/DQ(IZ, JZ,4) ,Q(I2, JZ,4) ,F(IZ, JZ,4) ,G(IZ, JZ,4) , 
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>  P( IZ, JZ) ,U(IZ, JZ) ,V(IZ, J2) ,UN(IZ, JZ) ,VN(IZ, JZ) 
COMMON/COORD/S A I X ( I Z , J2 ) , S A I Y ( I Z , JZ ) , ETAX ( I Z , JZ ) , ETAY ( I Z , JZ ) 

>  ,ZMUT( JZ),RJ(IZ, JZ),X(IZ, JZ),Y(IZ, JZ) ,DELTAU(IZ, JZ) 

>  , AREA( IZ) , ZMU( IZ, JZ) , Al( IZ, JZ) ,A2{ IZ, JZ) ,A3( IZ, JZ) ,A4( IZ, JZ) 
COMMON/CONST/A I N , AEX , RL , EX I , EYI , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 

>CFL1 , PRNT , PB , RMl , SUM ( 4 ) , ZMUO , REN, PRN, TWALL , TREF 
>,BI0T,TW1 

COMMON/CONST 1/GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , CP ( I Z , JZ ) , CV ( I Z , JZ ) , RGAS 
COMMON/ INTEG/IL, JL, ILl , JLl , NEND, NBEG, NADV, ITIME, IVISC,NORD, IWALL 

>  ,IWBC,IFLOW 

DIMENSION  RHO(IZ, JZ),RHOU(IZ, JZ),RHOV(IZ, JZ),E(IZ, JZ) 

EQUI VALENCE ( Q{ 1, 1, 1 ),RHO{ 1, 1 )), (Q( 1,1,2 ),RHOU( 1,1)), 

>  (Q(l,l,3),RHOV(l,l)),(Q(l,l,4),E(l,l)) 

ir  -k  if  -k  -k  "k  -k  'k  "k  -k  'k  -k  -k  "k  it  -k  'k  -k  it  it  -k  -fr  -k  "k  if  -k  -k  -k  it  -k  ic  ie  "k  -k  ic  "k  ic  ic  ic  -k  ie  ie  it  -k  -k  -k  -k  -k  'k  ie  -k  -k  ic  "k  ie  -k  rk  :k  -k 

c* 

C*  IF  THE  DIMENSION  IN  COMMON  BLOCK  MUST  BE  CHANGED 
C*  PLEASE  CHANGE  THE  PARAMETER  STATEMENT 
C* 

DIMENSION  SS(3500,4) 

NAMEL I  ST/ 1 NPUT/ 1 L , JL , NEND , PO , TO , CFL , OMEGAX , OMEGAY , RMl , A I N , FST , 

>  NITER, AEX, RL, THETA, C?0,GAMMA0,NBEG, ITIME, IVISC,NORD, IWALL, RM2 

>  , IREAD,PRN,REN,TREF,ZMU0,TWALL,FSTY,PB,PRNT,CFL1, IWBC,BI0T,TW1 

>  , I FLOW 

CALL  ERRSET(208,256,-1,0,0,0) 

C  . .  IL=TOTAL  GRID  NUMBER  IN  XI  DIRECTION 

C. . .  JL=TOTAL  GRID  NUMBER  IN  ETA  DIRECTION 

C. . .  NBEG=  COUNTING  INDEX  OF  ITERATION  STEP 

C  =1  FOR  THE  FIRST  RUN 

C  =ANY  NUMBER  EXCEPT  1  FOR  RERUN 

C. . .  NEND=  NUMBER  OF  ITERATIONS  FOR  THE  FIRST  RUN  ONLY 

C...  NITER=NUMBER  IF  ITERATIONS  TO  BE  RUN  WHEN  RERUN ( NBEG . NE . 1 ) 

C...  PO  =  STAGNATION  PRESSURE 

C. . .  PB=THE  BACK  PRESSURE  AT  THE  EXIT  OF  NOZZLE 
C  =0.  (SUBSONIC  FLOW  EXTRAPOLATED  FROM  INTERIOR) 

C  =  THE  SPECIFIED  BACK  PRESSURE  (FIXED  THE  PRESSURE  FOR 

C  SUBSONIC  PORTION  AT  EXIT) 

C...  TO  =  STAGNATION  TEMPERATURE 
C . . .  CFL  =  CFL  NUMBER 

C. . .  CFL1=  CFL  NUMBER  FOR  PNS  MARCHING 

C...  OMEGAX= ARTIFICIAL  DISSIPATION  CONSTANT  IN  XI  DIRECTION 

C...  OMEGA Y=ARTIFICIAL  DISSIPATION  CONSTANT  INETA  DIRECTION 

C. . .  IREAD  =  0  FOR  DEFAULT  CONICAL  NOZZLE 

C  1  READ  GRID  FROM  DATA  FILE 

C. . .  RMl  =THE  INITIAL  GUESS  FOR  INLET  MACH  NUMBER 

C. . .  RM2  =THE  INITIAL  GUESS  FOR  EXIT  MACH  NUMBER 

C...  AIN  =THE  INLET  RADIUS  FOR  CONICAL  NOZZLE  (IGNORED  IN  IREAD=1) 

C...  AEX  =THE  EXIT  RADIUS  FOR  CONICAL  NOZZLE  (IGNORED  IF  IREAD=1) 

C...  RL  =TOTAL  LENGTH  OF  CONICAL  NOZZLE  (IGNORED  IF  OREAD=l) 

C. . .  ITIME=  0  FOR  CONSTANT  DT  1  FOR  CONSTANT  CFL 
C...  IVISC=  0  INVISCID  FLOW 
C  1  VISCOUS  FLOW 

C. . .  NORD  =  0  FOR  FIRST  ORDER  UPWIND  IN  XI 
C  1  FOR  SECOND  ORDER  UPWIND  IN  XI 

C...  FST  =  STRETCHING  FACTOR  IN  XI  DIRECTIO  (0  FOR  UNIFORM  GRID) 

C...  FSTY=  STRETCHING  FACTOR  IN  ETA  DIRECTION  (0  FOR  UNIFORM  GRID) 
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FECIFIC  HEAT 
,  NUMBER 
'  F'.OW 


>■  ;  .'k  OFF  IN  THIS  SUBROUTINE) 

'  :  L 

TEMPERATURE 


OF  COOLING  LIQUID 
'^.E  INLET  (M.  CP/2  PI  K 
.  FROM  INLET  TO  EXIT 


c 

:  S'.OW  FROM  EXIT  TO  INLET 

C 

GNLT  VALID  FOR  IFL0W=-1 

c . 

Tv'S 

D'D'  '.•M.L  TEMPERATURE  FOR  IWALL=1 

c . 

.  .  i.  -■ 

.  DE'vMlMCE  TEMPERATURE  FOR  VISCOSITY 

c. 

.  .  ZIT'O 

D  VISCOSITY  AT  T=TREF 

c . 

,  .  ivif;-  - 

:'v  R  EXPLICIT  WALL  B.  C. 

c 

'dOk  IMPLICIT  WALL  B.  C. 

c 

**  READ  ^ 

i  1  L 

T  DATA 

REA.L  ( 

0  .  T 

MFUT) 

v;r  :T\i 

( 

, INPUT) 

c 

SET  'JF 

GK 

OM'E’IRY 

ILl=i 

L-1 

JEM  =J 

i — * 

c 

c 

V  '  * 

S(  -1  .1)0) 

c 

TURK  0“ 

fF',’ 

ERSE  COOLING  FLOW 

1 1  (  ME 

Fi'"* 

DQ.l)  IFL0W=1 

c 

DO  10 

7 

1 ,  I  L 

YIN) 


CALCULATION 


.'i  r^  !  A  \ 

cor^'L' 

DO  2 
DO  2 
X(I, 

Y(  T,  I)- 
IF ( FST . 


10 


20 


;  A I N  (  AEX- AI N )  *DFLOAT  ( I  - 1 )  /DFLOAT  (  I  LI ) 


INi’E 
0  I 
0  A 


yr- 


DO  -  ( 
DG  J 
xr,-D 
AREA 
DO  ] 
X(  I, 


FST 
5  1 
0 ( 
(  ! 


=  I  ,  IL 
-1,  JL 

DFLOAT ( I-l )/DFLOAT( IL1)*RL 
DFLOAT( J-1 )/DFLOAT( JL1)*AREA( I ) 
NE , 0 .DO) THEN 
-1.0)/(FST**IL1-1. )*RL 

-1  ,  IL 


FfST’"*  (  I-l  )-l  .  )/(FST-l .  ) 
A I H  t-XL/RL*  ( AEX- AI N ) 

J-1 , JL 
)-  XL 
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Y  (  I  ,  J  )  --  DFLOAT  (  J-  1 )  /DFLOAT  (  JLl )  *AREA(  I  ) 

COMTIMUE 
Er,.SE 
ENDI  F 


C*  STRETCH 
IF(  F 

DO 


THE  GRID  ALONG  Y-DIRECETION  IN  VISCOUS  CASE 
STY. ME. 0. DO) THEN 
17  1  =  1, 1  r, 
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Y(I,1)=0. 

DA0=( 1. -FSTY)/( 1 . -FSTY**JL1)*AREA( I ) 

DO  17  J=2,JL 

Y( I , J)=Y( I, J-l)+DA0*FSTY**(J-2) 

17  CONTINUE 
ELSE 
END  IF 

C  *  READ  GRID  FROM  DATA  FILE 
IF( IREAD.EQ. 1)THEN 
DO  25  1=1, IL 
DO  25  J=1,JL 

READ(38)III, JJJ,X(I, J),Y(I, J) 

25  CONTINUE 
ELSE 
END  IF 

C  **  COORDINATE  TRANSFORMATION 
EXI=1.0 
EYI  =  1 . 0 
DO  30  1=1, IL 
IP1=I 
IM1=I-1 

IF( I .EQ  1) IM1=1 
IF( I .EQ. 1)IP1=2 
DSAI=2 . *EXI 

IF( I .EQ. 1 .OR. I .EQ. IL)DSAI=EXI 

DO  30  J=1,JL 

JP1=J+1 

JM1=J-1 

IF( J.EQ. 1) JM1=1 
IF( J.EQ. JL)JP1=JL 
DETA=2 . *EYI 

I F ( J . EQ . 1 . OR . J . EQ . JL ) DETA=EYI 
XSAI=(X( IPl, J)-X( IMl, J) ) 

YSAI=(Y( IPl, J)-Y( IMl, J) ) 

XETA=(X{ I, JP1)-X( I, JMl) )/DETA 
YETA= ( Y ( I , JP 1 ) - Y ( I , JMl ) ) /DETA 
IF(I .GT.2.AND. I.LT. IL1)THEN 
XSAI=XSAI+NORD*0. 5*(X( I , J ) -2 . *X( I-l , J ) +X( I -2 , 
YSAI=YSAI+NORD*0. 5*(Y( I , J ) -2 . *Y( I - 1 , J ) +Y( I -2 , 
END  IF 

IF( J.EQ. 1)THEN 

XETA=XETA-0 . 5* ( X( I , J) -2 . *X( I , J+1 ) +X( I , J+2 ) ) 
YETA=YETA-0 . 5* ( Y( I , J ) -2 . *Y( I , J+1 ) +Y( I , J+2 ) ) 
ELSE 
ENDIF 
C 

IF(J.EQ.JL)  THEN 

XETA= ( 3 . DO*X( I , JL ) -4 . DO*X( I , JL- 1 ) +X( I , JL-2 ) ) *0 
YETA={3 .DO*Y( I, JL)-4.D0*Y( I, JL-1)+Y(I, JL-2) )*0 
ELSE 
ENDIF 
C 

RJP=XSAI *YETA-XETA*YSAI 
RJ(I, J)=1./RJP 
SA I X ( I , J ) = YETA/R JP 
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.  5D0 
.  5D0 
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SAIY( I , J)=-XETA/RJP 
ETAX( I , J)=-YSAI/RJP 
30  ETAY( I , J)=XSAI/RJP 
C  **  INITIALIZATION 

RGAS=8314. 3/20. 405 
R=RGAS 

DO  991  1=1, IL 
DO  991  J=1,JL 
TTT=3061 . IDO 

CALL  CPGAM ( CP ( I , J ) , CV ( I , J ) , GAMMA (I,J),GM1(I,J), RGAS , I , J , 

>  RHO ( I , J ) , RHOU ( I , J ) , RHOV (I,J),E(I,J), TTT ) 

991  CONTINUE 

C  GM10=GAMMA0-1 . 

C  R=CP0*GM10/GAMMA0 

C  CV0=CP0/GAMMA0 

C 
C* 

C*  GIVE  THE  INITIAL  VALUE  OF  VISCOSTY 

C*  IF  THE  VISCOSITY  AT  T=TREF  IS  GIVEN  FROM  INPUT 

C*  THE  CALCULATION  FOR  ZMUO  MUST  BE  SWITCHED  OFF 

C* 

C  TIN=T0/(1.+0.5*GM10*RM1**2) 

C  UIN=RM1*DSQRT(GAMMA0*R*TIN) 

C  PIN=P0*( TIN/TO )**(GAMMA0/GM10) 

C  RIN=PIN/(R*TIN) 

BIOT=BIOT*Y(l, JL) 

C  ZMU0=(RIN*UIN*AREA(1)*2. )/REN 

C*  CALCULATE  METRIC  TERMS  AT  MID  POINTS 
C* 

CALL  MCONST 

C  **  SKIP  TO  RERUN  THE  CODE 
IF(NBEG.NE. l)GOTO  300 
C  **  READ  IN  THE  STARTING  LINES 
DO  60  1=1,2 
DO  60  J=1,JL 

READ(68)  (Q(I, J,K),K=1,4) 

TCP=0.D0 

CALL  CPGAM ( CP ( I , J ) , CV ( I , J ) , GAMMA (I,J),GM1(I,J), RGAS , I , J , 

>  RHO( I, J) ,RHOU( I, J) ,RHOV( I, J) ,E(I, J),TCP) 

50  CONTINUE 

U(I, J)=RHOU(I, J)/RHO(I, J) 

V(I, J)=RHOV(I, J)/RHO(I, J) 

UN(I, J)=U(I, J)*SAIX( I, J)+V(I, J)*SAIY(I, J) 

VN( I , J)=U( I , J) *ETAX( I , J) +V( I , J)*ETAY( I , J) 

P(I, J)  =GM1(I, J)*(E(I, J)-0.5*RH0(I, J)*(U(I, J)**2+V(I, J)**2)) 
60  CONTINUE 
C  REWIND  68 

C 

RETURN 

300  CONTINUE 

310  READ( 19, 720,END=1000)NDUM, ( SS(NDUM, K) , K=1 , 4) 

GOTO  310 
1000  CONTINUE 
REWIND  19 
NBEG=NDUM+1 
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NEND=NBEG+NITER- 1 
DO  320  N=1,NDUM 

320  WRITE ( 19, 720 )N, ( SS (N, K ) , K=1 , 4 ) 

720  F0RMAT(I5,3X,4(1X,E14.7)) 

DO  330  1=1, IL 
DO  330  J=1,JL 

READ (66)  (Q(I,J,K),K=1,4), DELTAU ( I , J ) 

TCP=O.DO 

CALL  CPGAM ( CP ( I , J ) , C V ( I , J ) , GAMMA (I,J),GM1(I,J), RGAS , I , J , 

>  RHO( I , J ) , RnOU( I , J ) , RHOV( I,J),E(I,J), TCP ) 

U( I, J)=RHOU(I, J)/RHO( I, J) 

V(I, J)=RHOV(I, J)/RHO(I, J) 

UN(I, J)=U( I, J)*SAIX(I, J)+V(I, J)*SAIY(I, J) 

VN(I, J)=U(I, J)*ETAX(I, J)+V(I, J)*ETAY(I, J) 

P( I, J)  =GM1( I, J)*(E( I, J)-0.5*RHO(I, J)*(U( I, J)**2+V(I, J)**2) ) 
CO=DSQRT(GAMMA( I, J)*P( I, J)/RHO(I, J) ) 

CX=DSQRT(SAIX( I , J ) * *2 +SAI Y( I , J ) **2 ) 

CY=DSQRT ( ETAX ( I , J ) *  *  2  +  ETAY ( I , J ) *  *2 ) 

CX= ( UN ( I , J ) +  CX*  CO ) /EX I 
CY= ( VN ( I , J ) +CY*CO ) /EYI 
EIGNN=DABS(CX) 

I F ( E I GNN . LE . DABS ( CY ) ) E I GNN=DABS ( CY ) 

DELTAU ( I , J ) =CFL/E I GNN 
330  CONTINUE 
REWIND  66 
RETURN 
END 

C . . - . - - - 

SUBROUTINE  SOLVE 
C* 

C*  SOLVE  SUBROUTINE 
C* 

Q***************************************************************** 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( IZ=1 50 , JZ=80 ) 

COMMON/VECTOR/DQ (IZ,JZ,4),Q(IZ,JZ,4),F(IZ,JZ,4),G(IZ,JZ,4), 

>  P( IZ, JZ) ,U( IZ, JZ) ,V( IZ, JZ),UN( IZ, JZ) , VN( IZ, JZ) 
COMMON/COORD/SAIX( IZ, JZ) , SAIY( IZ, JZ) ,ETAX( IZ, JZ) ,ETAY( IZ, JZ) 

>  ,ZMUT(JZ),RJ(IZ, JZ),X(IZ, JZ),Y(IZ, JZ),DELTAU(IZ, JZ) 

>  , AREA( IZ) ,ZMU( IZ, JZ) , Al( IZ, JZ),A2(IZ, JZ) ,A3( IZ, JZ) ,A4(IZ, JZ) 
COMMON/CONST/AIN, AEX, RL, EX I , EYI , OMEGAX, OMEGAY, CFL, THETA, PO, TO, 

>CFL1,PRNT,PB,RM1, SUM(4) , ZMUO, REN, PRN, TWALL, TREF 
>, BI0T,TW1 

COMMON/CONST 1 /GAMMA ( I Z , JZ ) , GMl ( IZ, JZ ) , CP ( IZ, JZ ) , CV( IZ, JZ) ,RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV, ITIME, IVISC,NORD, IWALL 

>  ,IWBC,IFLOW 

DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ) ,RHOV( IZ, JZ) , E( IZ, JZ) 
EQUIVALENCE(Q(1, 1, 1) ,RH0(1, 1) ) , (Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(1,1,3),RH0V(1,1)), (Q( 1,1,4), E( 1,1)) 

0* ****************************************************************** 

C* 

C*  STRAT  THE  CODE  BY  PNS  A  PLUS  MARCHING 
C* 

IF(NADV.NE. 1)G0T0  5 
CALL  PNS 
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RETURN 

CONTINUE 

.u 

CALL  FLUX(l) 

CALL  FLUX(2) 

IF(IVISC.EQ. 1)THEN 
CALL  MULAM{1) 

CALL  MULAM(2) 

END  IF 

DO  40  1=3 , IL 

* 

*  THIS  DO  LOOP  CONTROLS  THE  LOCAL  ITERATION  FOR 

*  EACH  CONSTANT  XI  LINE 

* 

DO  35  L0CAL=1,1 
CALL  RHS(I) 

IF( IVISC.EQ. 1)  THEN 
CALL  MULAM(I) 

IF(PRNT.NE.O.DO)  CALL  MUTUR(I) 

END  IF 

IF( IVISC.EQ. 1)CALL  VRHS(I) 

*  CALCULATE  RESIDUAL 

DO  10  J=1,JL 
DO  10  K=l,4 

10  DQ( I , J,K)=-DELTAU( I , J)*DQ( I , J,K) 

* 

*  ADD  ETA-DIRECTION  4TH  ORDER  ARITFICIAL  VISCOSITY 

* 

IF(OMEGAY.NE.O.DO)CALL  ADDY(I) 

fc 

*  SOLVE  L-ETA  OPERATOR 

it 

CALL  COEFY(I) 

k 

*  UPDATE  VARIABLES  AFTER  X-SWEEP 

k 

JEND=JL 

IF( IVISC.EQ. 1)JEND=JL1 
DO  20  J=2,JL 
RJJ=RJ( I, J)/Y( I, J) 

DO  15  K=l,4 

15  Q(I, J,K)=Q(I, J,K)+DQ(I, J,K)*RJJ 
TCP=0 . DO 

CALL  CPGAM ( CP ( I , J ) , CV ( I , J ) , GAMMA ( I , J ) , GMl ( I , J ) , RGAS , I , J , 

>  RHO ( I , J ) , RHOU ( I , J ) , RHOV (I,J),E(I,J), TCP ) 

U( I , J ) =RHOU( I , J )/RHO( I , J ) 

V(I, J)=RHOV(I, J)/RHO(I, J) 

UN( I, J)=SAIX(I, J)*U{ I, J)+SAIY( I, J)*V(I, J) 

VN(I, J)=U(I, J)*ETAX(I, J)+ETAY(I, J)*V(I, J) 

P( I, J)=GM1(I, J)*(E(I, J)-0.5*RHO(I, J)*(U(I, J)**2+V(I, J)**2) ) 
20  CONTINUE 

CALL  CLBC(I) 

I F ( I V I SC . EQ . 1 . AND . I WBC . EQ . 0 ) CALL  WALLBC ( I ) 

35  CONTINUE 
40  CONTINUE 
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C* 

C*  BACKWARD  SWEEP! 

C* 

DO  90  IB=2 , IL-2 
I=IL-IB+1 
DO  86  L0CAL=1,1 
CALL  RHS(I) 

IF( IVISC.EQ. 1)  THEN 
CALL  MULAM(I) 

IF(PRNT.NE.O.DO)  CALL  MUTUR(I) 

ENDIF 

I F( IVISC.EQ. 1 )CALL  VRHS(I) 

DO  50  J=1,JL 
DO  50  K=l,4 

50  DQ( I, J,K)=-DELTAU( I, J)*DQ( I, J,K) 

IF{OMEGAY.NE.O.DO)CALL  ADDY(I) 

CALL  COEFY( I ) 

C* 

C*  UPDATING  VARIABLES 
C* 

DO  70  J=2,JL 
RJJ=RJ(I, J)/Y(I, J) 

DO  60  K=l,4 

60  Q(I, J,K)=Q(I, J,K)+DQ(I, J,K)*RJJ 
TCP=O.DO 

CALL  CPGAM ( CP ( I , J ) , CV ( I , J ) , GAMMA ( I , J ) , GMl ( I , J ) , RGAS , I , J , 

>  RHO( I, J),RHOU( I , J),RHOV( I, J),E(I, J),TCP) 

U(I, J)=RHOU(I, J)/RHO(I, J) 

V(I, J)=RHOV(I, J)/RHO(I, J) 

UN(I, J)=U(I, J)*SAIX(I, J)+V(I, J)*SAIY(I, J) 

VN(I, J)=U(I, J)*ETAX(I, J)+V(I, J)*ETAY(I, J) 

P( I, J)=GM1(I, J)*(E(I, J)-0.5*RHO(I, J)*(U(I, J)**2+V(I, J)**2) ) 
CO=DSQRT( GAMMA ( I , J) *P( I , J)/RHO{ I , J) ) 

CX=DSQRT(SAIX( I , J ) **2+SAI Y( I , J ) **2 ) 

CY=DSQRT(ETAX( I, J)**2+ETAY( I, J)**2) 

CX=(UN( I, J)+CX*CO) 

CY=(VN(I, J)+CY*CO) 

EIGNN=DABS(CX) 

IF(EIGNN. LE.DABS(CY) ) EIGNN=DABS(CY) 

DELTAU(I , J)=ITIME*CFL/EIGNN+(1-ITIME)*DELTAU( I, J) 

70  CONTINUE 
C  * 

C  *  CENTERLINE  BOUNDARY  CONDITIONS 
CALL  CLBC(I) 

IF( IVISC.EQ. 1 .AND. IWBC . EQ . 0 )CALL  WALLBC(I) 

86  CONTINUE 
90  CONTINUE 
RETURN 
END 
C* 

C*  THIS  SUBROUTINE  SOLVE  THE  FLOW  FIELD  BY 
C*  MARCHING  IN  XI  DIRECTION 
C* 

SUBROUTINE  PNS 

C******************************************************************* 
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IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  (  I  7,=150  ,  JZ=80  ) 

COMMON /VECTOR/DQ ( I Z , JZ , 4 ) , Q ( I Z , JZ , 4 ) , F ( I Z , JZ , 4 ) , G ( I 2 , JZ , 4 ) , 

>  r( IZ, J2) ,U( IZ, JZ) , V( IZ, JZ) ,UN( IZ, J2) , VN( IZ, JZ) 
COMMON/ COORD/S A I X (  1 Z , JZ ) , S AI Y ( I Z , JZ ) , ETAX ( I Z , JZ ) , ETAY ( I Z , JZ ) 

->  ,  ZMUT(  JZ)  ,  RJ(  IZ,  JZ)  ,  X(  IZ,  JZ)  ,  Y(  IZ,  JZ)  ,DELTAU(  IZ,  JZ) 

>  , AREA ( I Z ) , ZMU { I Z , JZ ) , A 1 ( I Z , JZ ) , A2 { I Z , JZ ) , A3 ( I Z , JZ ) , A4 ( I Z , JZ ) 
COMMON/CONST/A I N , AEX , R  L , EX I , EY I , OMEGAX , OMEGAY , CEL , THETA , PO , TO , 

>CFL1  ,  PRNT,  PB,  RMI  ,  SIJM(4)  ,  ZMUO,REN,  PRN,  TWALL,  TREF 
>, BIOT, TWl 

COMMON/CONSTl,,  GAMMA  (  IZ,  JZ)  ,  GMl  ( IZ ,  JZ  )  ,  CP  ( IZ ,  JZ  )  ,CV(  IZ,  JZ)  ,  RGAS 
COMMON/ INTEG/I L, JL, I  LI , JLl , NEND, NBEG, NADV, ITIME, IVISC,NORD, IWALL 

>  ,IWBC,IFLOW 

DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ) ,RHOV( I Z , JZ ) , E ( IZ , JZ ) 

EQUIVALENCE (Q(l, 1,1), RH0(1, 1) ) , (Q(l, 1,2) , RHOU( 1, 1 ) ) , 

>  (Q(l, 1,3) ,RH0V(1,1) ), (Q(1,1,4),E(1, 1) ) 

Qx'.>x**xx**Ar**-*******************x*********************************** 

DIMENSION  SS(4) 

DATA  INNER/200/ 

C  **  FORWARD  SWEEP 

WRITE(19,*)  '  ****  PNS  MARCHING  BEGINS  ****' 

IF( IVISC.EQ. 1)  CALL  MULAM(l) 

IF( IVISC. EQ. 1 )  CALL  MULAM(2) 

CALL  FLUX(l) 

CALL  FLUX(2) 

DO  999  1=3, iL 
WRITE(  19,  *  )  '  1='  ,  I 

C* 

C*  GIVE  THE  INITIAL  GUESS  FROM  PREVIOUS  LINE 
C* 

DO  17  J=1,JL 

C  DELTAU( I, J)=DELTAU( I-l, J) 

DO  16  K=l,4 

lo  Q(  I ,  J, i  -1/ J/ N) 

TCP=0 -DO 

CALL  CPGAM ( CP ( I , J ) , CV ( I , J ) , GAMMA ( I , J ) , GMl ( I , J ) , RGAS , I , J , 

>  RHO( I , J) ,RHOU( I , J) ,RHOV( I , J) , E( I , J) , TCP ) 

RHO( I , J)=RHO( I-l, J) 

U(I, J)=U(I-1, J) 

V(I, J)=V(I-1, J) 

UN( I , J)=U( I , J)*SAIX( I, J)+V( I, J)*SAIY( I, J) 

VN(I, J)=U(I, J)*ETAX(I, J)+V(I, J)*ETAY(7, J) 

IF(J.EQ.JL)  VN(I,J)=0.D0 
I F ( J . EQ . JL ) V( I , J ) =-U ( I , J ) *ETAX ( I , J ) /ETAY ( I , J ) 

I F ( J . EQ . JL )  Q ( I , J , 2 ) =RHO ( I , J ) *U ( I , J ) 

IF( J.EQ. JL)  Q(I, J,3)=RH0( I , J)*V(I, J) 

P(I, J)=P(I-1,J) 

17  CONTINUE 
C  IF(I.EQ.2)  THEN 

DO  19  J=1,JL 

C0=DSQRT( GAMMA ( I , J ) *P ( I , J )/RHO( I , J ) ) 

CY=VN( I , J) +DSQRT(ETAX( I , J ) **2+ETAY( I , J)**2)*C0 
CX=UN( I , J) +DSQRT(SAIX( I , J) **2+SAIY( 1 , J)**2)*C0 
DELTAU( I , J)=CFL1/DABS(CY) 

C  DELTAU( I , J)=CFL1/DABS(CX) 
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19  CONTINUE 
C  END IF 

C* 

DO  998  IC0UNT=1, INNER 
C*  RHS  CALCULATION 
CALL  RHS( I ) 

IF{ IVISC.EQ. 1)  CALL  MULAM(I) 

IF(PRNT.NE.O.DO)  CALL  MUTUR(I) 

IF( IVISC.EQ. 1)  CALL  VRHS(I) 

DO  40  J=1,JL 
DO  40  K=l,4 

40  DQ(I,J,K)=- DELTAU (I,J)*DQ(I,J,K) 

C* 

C*  ADD  ETA-DIRECTION  4TH  ORDER  ARTIFICIAL  VISCOSITY 

C* 

IF(OMEGAY.NE.O.ODO)CALL  ADDY(I) 

C* 

C*  SOLVE  LETA- OPERATOR 
C* 

CALL  COEFY(I) 

C* 

C*  UPDATING  VARIABLES 
C* 

DO  70  J=2,JL 
RJJ=RJ(I, J)/Y(I, J) 

DO  60  K=l, 4 

60  Q ( I , J , K ) =Q { I , J , K ) +DQ ( I , J . K ) *RJ  J 

TCP=0.D0 

CALL  CPGAM(CP(I, J),CV(I, J),GAMMA(I, J),GM1(I, J),RGAS, I, J, 

>  RHO{I, J) ,RHOU(I, J),RHOV(I, J),E(I, J),TCP) 

U(I, J)=RHOU(I, J)/RH0(I, J) 

V(I, J)=RHOV(I, J)/RHO(I, J) 

UN( I. J)=U( I, J)*SAIX(I, J)+V(I, J)*SAIY(I, J) 

VN( I, J)=U(I, J)*ETAX(I, J)+V(I, J)*ETAY(I, J) 

P(I, J)=GM1( I, J)*(E( I, J) -0.5*RHO( I, J)*(U( I, J)**2+V( I, J)**2) ) 
CO=DSQRT(GAMMA{I, J)*P( I, J)/RH0(I, J) ) 

CX=DSQRT(SAIX(I, J)*SAIX(I, J)+SAIY(I, J)*SAIY(I, J)) 

CY=DSQRT ( ETAX ( I , J ) *ETAX ( I , J ) +ETAY( I , J ) *  ETAY ( I , J ) ) 

CX={UN(I, J)+CX*CO)/EXI 
CY=(VN{ I, J)+CY*CO)/EYI 
EIGNN=DABS(CY) 

DELTAU( I , J)=ITIME*CFL1/EIGNN+(1-ITIME) *DELTAU( I, J) 

70  CONTINUE 
C* 

C*  EXTRAPOLATE  FROM  FIELD  POINT  TO  CENTER  LINE 
C* 

CALL  CLBC(I) 

IF( IVSC.EQ. 1 .AND. IWBC.EQ.O)CALL  WALLBC( I ) 

C* 

C*  CALCULATE  THE  ERROR 
C* 

DO  110  K=l,4 
110  SS(K)=0. 

DO  120  J=1,JL 
DO  120  K=l,4 
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QQ-Q(I, J,K) 

IF(QQ.EQ.O.DO.OR.Y(I, J) .EQ.O.DO)GO  TO  120 
SS(K)-SS(K)+(DQ(I, J,K)/(QQ*Y(I, J)/RJ(I, J) ) )**2 
120  CONTINUE 
QSUM=0 . 

DO  130  K=l,4 
QSUM^QSUM+DSQRT { SS ( K ) ) 

130  SS(K)=DSQRT(SS(K) )/( IL*JL) 

QSUM=QSUM/4./( IL*JL) 

IF(QSUM. LE. 1 .D-13 )  GOTO  995 
WRITE ( 19, 500) ICOUNT, ( SG ( K ) , K=1 , 4 ) 

500  FORMAT( I5,3X,4(1X,E14.7) ) 

998  CONTINUE 
995  CONTINUE 

WRITE( 19, 510)  (SS(K) ,K=1, 4) 

510  FORMATC  &&&  '  ,  4(  IX,  E14. 7)  ) 

999  CONTINUE 

WRITE(19,*)  '  ''***  PNS  MARCHING  ENDS  ****** 

CALL  MASS 
RETURN 
END 
C* 

C*  SUBROUTINE  FOR  CALCULATING  METRIC  TERMS 
C*  AT  THE  MIDPOINT 

SUBROUTINE  MCONST 

Q****************************** ************************************* 

IMPLICIT  REAL*8{A-H,0-Z) 

PARAMETER  ( IZ=150 , JZ=80 ) 

COMMON/VECTOR/DQ( IZ,JZ,4),Q(IZ,JZ,4),F(IZ,JZ,4),G(IZ,JZ,4), 

>  P( IZ, JZ) ,U( IZ, JZ),V(IZ, JZ) ,UN{ IZ, JZ) ,VN(IZ, JZ) 
COMMON/COORD/SAIX( IZ, JZ) , SAIY( IZ, JZ) ,ETAX( IZ, JZ) ,ETAY( IZ, JZ) 

>  , ZMUT( JZ) ,RJ( IZ, JZ) ,X( IZ, JZ) ,Y( IZ , JZ ) , DELTAU( IZ, JZ) 

>  , AREA( IZ) , ZMU( IZ, JZ) , Al( IZ, JZ) , A2( IZ, JZ) , A3( IZ, JZ) , A4( IZ, JZ) 
COMMON/CONST/A I N , AEX , RL , EX I , EY I , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 

>CFL 1 , PRNT , PB , RMl , SUM ( 4 ) , ZMUO , REN , PRN , TWALL , TREF 
>,BI0T,TW1 

COMMON/CONST 1/GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , CP ( I Z , JZ ) , CV ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, ILl , JLl , NEND, NBEG, NADV, ITIME, IVISC,NORD, IWALL 

>  ,IWBC,IFLOW 

DIMENSION  RHO( IZ , JZ ) , RHOU( IZ , JZ ) , RHOV( IZ , JZ ) , E ( IZ , JZ ) 
EQUIVALENCE(Q(1, 1, 1) ,RH0(1, 1) ), (Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q( 1, 1,3 ),RHOV( 1, 1 )), (Q( 1,1,4), E(l,l)) 

Q******************************************************************* 

DATA  FD3,OD3/l . 333333333333,0.333333333333/ 

DO  20  1=2, IL 
DO  20  J=1,JL1 
IF( I .EQ. IL)THEN 

XSAI=0.5*(X( I, J)+X( I, J+1)-X(I-1, J)-X( I-l, J+1) ) 

YSAI=0.5*(Y(I, J)+Y(I, J+1)-Y(I-1, J)-Y(I-1, J+1) ) 

ELSE 

YSAI=0.25*(Y(I  +  1,  J+l)+Y(  la,  J)-Y(I-1,  J+l)-y(I-l,  J)  ) 

XSAI=0.25*(X( I  +  l, J+l)+X( 1*1, J)-X( I-l, J  +  l)-X( I-l,  J) ) 

END  IF 

YETA=Y(I, J+1)-Y(I, J) 

XETA=X(I, J+1)-X(I, J) 
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RJ J=1 . / ( XSAI * YETA-XETA* YSAI ) 

Al( I , J)=RJJ*(FD3*YSAI**2+XSAI**2) 

A2 ( I , J)=-RJJ*OD3*XSAI*YSAI 

A3( I , J)=RJJ*(YSAI**2+FD3*XSAI**2) 

A4( I, J)=RJJ*(XSAI**2+YSAI**2) 

20  CONTINUE 
RETURN 
END 

C - 

SUBROUTINE  SMOOTH 
C* 

C*  ADD  ARTIFICIAL  D I  SSI RATIONAL  TERM  FOR  SA I , ETA-DIRECTION 
C* 

0*******-<r********************************************************* 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( IZ=150, JZ=80) 

COMMON/VECTOR/DQ(IZ, JZ,4),Q(IZ, JZ,4),F(IZ, JZ,4),G(IZ, JZ,4), 

>  P(IZ, JZ),U(IZ, JZ),V(IZ, JZ),UN(IZ, JZ),VN(IZ, JZ) 
COMMON/COORD/SAIX ( I Z , JZ ) , SAI Y ( IZ , JZ ) , ETAX ( IZ , JZ ) , ETAY ( IZ , JZ ) 

>  ,ZMUT( JZ) ,RJ( IZ, JZ) ,X( IZ, JZ) ,Y(IZ, JZ) ,DELTAU( IZ, JZ) 

>  ,AREA(I2),ZMU(IZ, JZ),A1(IZ, JZ),A2(IZ, JZ),A3(IZ, JZ),A4(IZ, JZ) 
COMMON/CONST/AIN, AEX, RL, EXI , EYI , OMEGAX, OMEGAY, CFL, THETA, PO, TO, 

>CFL 1 , PRNT , PB , RMl , SUM ( 4 ) , ZMUO , REN, PRN, TWALL, TREF 
>,BI0T,TW1 

COMMON/CONS T1 /GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , CP ( I Z , JZ ) , CV ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV, ITIME, IVISC,NORD, IWALL 

>  ,IWBC,IFLOW 

DIMENSION  RHO(IZ, JZ) ,RHOU(IZ, JZ),RHOV(IZ, JZ),E(IZ, JZ) 
EQUIVALENCE(Q(1,1,1),RH0(1,1)), (Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(1,1,3),RH0V(1,1)), (Q(1,1,4),E(1,1)) 

0* ****************************************************************** 
DIMENSION  ADD(4) 

C  **  SAI-DIRECTION 
ENTRY  ADDX 
COEF=0 . 125DO*OMEGAX 
DO  70  J=1,JL 
DO  70  1=1, IL 
IF( I .EQ. 1)  GO  TO  10 
IF(I .EQ.2)  GO  TO  20 
IF( I .EQ. ILl)  GO  TO  30 
I F ( I . EQ . I L )  GO  TO  40 
DO  5  K=l,4 

5  ADD(K)=COEF*(Q( 1+2, J,K)-4.*Q(I+1, J,K) 

>  +6.*Q(I, J,K)-4.*Q(I-1, J,K) 

>  +Q(I-2,J,K)) 

GO  TO  50 

10  DO  15  K=l,4 

QM=2.*Q(1, J,K)-Q(2, J,K) 

QMM=2.*QM-Q(1, J,K) 

15  ADD(K)=COEF*(Q( 1+2, J,K)-4.*Q(I+1, J,K) 

>  +6.*Q(I, J,K)-4.*QM+QMM) 

GO  TO  50 

20  DO  25  K=l,4 

QMM=2.*Q(1, J,K)-Q(2, J,K) 

25  ADD(K)=COEF*(Q( 1+2, J,K)-4.*Q( I+l, J,K) 
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>  +6.*Q(I, J,K)-4.*Q(I-1, J,K) 

>  +QMM) 

GO  TO  50 

30  DO  35  K=l,4 

QPP=2.*Q(I+1, J,K)-Q(I, J,K) 

35  ADD(K)=C0EF*(QPP-4. *Q( I+l, J,K)+6.*Q( I , J,K) 

>  -4.*Q(I-1, J,K)+Q(I-2, J,K) 

>  ) 

GO  TO  50 

40  DO  45  K=l,4 

QP=2.*Q(I, J,K)-Q(I-1, J,K) 

QPP=2.*QP-Q(I, J,K) 

45  ADD(K)=C0EF*(QPP-4. *QP+6. *Q( I, J,K)-4. * 

>  Q(I-1, J,K)+Q(I-2, J,K)) 

50  CONTINUE 

DO  60  K=l,4 

60  DQ( I, J,K)=DQ(I, J,K)-ADD(K)/RJ(I, J)*Y(I, J) 

70  CONTINUE 
RETURN 

C  ** 

C  ADD  ETA-DLRECTLON  4TH  ORDER  ARTLFLCLAL  VLSCOSLTY 
C  ** 

ENTRY  ADDY(II) 

I  =  II 

COEF=0. 125DO*OMEGAY 
DO  170  J=1,JL 
IF( J.EQ. 1)  GO  TO  110 
IF(J.EQ.2)  GO  TO  120 
IF(J.EQ.JLl)  GO  TO  130 
IF(J.EQ.JL)  GO  TO  140 
DO  95  K=l,4 

95  ADD{K)=COEF*(Q( I, J+2,K)-4.*Q(I, J+1,K) 

>  +6.*Q(I, J,K)-4.*Q(I . J-1,K) 

-  +Q(I,J-2,K)) 

GO  TO  150 
110  DO  115  K=l,4 

QM=2.*Q(I,1,K)-Q(I,2,K) 

QMM=2.*QM-Q(I,1,K) 

115  ADD(K)=COEF*(Q(I , J+2,K)-4.*Q( I, J+1,K) 

>  +6.*Q(I, J,K)-4.*QM+QMM) 

GO  TO  150 

120  DO  125  K=l,4 

QMM=2.*Q(I,1,K)-Q(I,2,K) 

125  ADD(K)=COEF*(Q( I, J+2,K)-4. *Q(I, J+1,K) 

>  +6.*Q(I, J,K)-4.*Q(I, J-1,K) 

>  +QMM) 

GO  TO  150 

130  DO  135  K=l,4 

QPP=2 . *Q( I , J+1,K)-Q( I , J,K) 

135  ADD(K)=COEF*(QPP-4. *Q( I , J+l,K)+6. *Q( I , J,K) 

>  -4.*Q(I, J-1,K)+Q(I, J-2,K) 

>  ) 

GO  TO  150 
140  DO  145  K=l,4 

QP=2.*Q(I, J,K)-Q(I, J-1,K) 
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QPP=2.*QP-Q(I, J,K) 

145  ADD{K)=C0EF*(QPP-4. *QP+6. *Q( I, J,K)-4. * 

-  Q(I, J-1,K)+Q(I, J-2,K)) 

150  CONTINUE 

DO  160  K=l,4 

160  DQ ( I , J , K ) =DQ ( I , J , K ) - ADD ( K ) /R J (I,J)*Y(I,J) 

170  CONTINUE 
RETURN 
END 
C 

C  **  SUBROUTINE  FOR  CENTER  LINE  BOUNDARY  CONDITIONS 
SUBROUTINE  BC 

C - - 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( IZ=150 , JZ=80 ) 

COMMON/VECTOR/DQ(IZ, JZ,4),Q(IZ, JZ,4),F(IZ, JZ,4),G(IZ, JZ,4), 

>  P(IZ, JZ) ,U(IZ, JZ),V(IZ, JZ),UN(IZ, JZ),VN(IZ, JZ) 
COMMON/COORD/SA IX(IZ,JZ),SAIY(IZ,JZ), ETAX ( I Z , JZ ) , ETAY ( I Z , JZ ) 

>  ,ZMUT( JZ) ,RJ( IZ, JZ) ,X( IZ, JZ) , Y( IZ , JZ ) , DELTAU( IZ, JZ) 

>  , AREA( IZ) ,ZMU(IZ, JZ) ,A1( IZ, JZ) , A2 ( IZ , JZ ) , A3 ( I Z , JZ ) , A4( IZ , JZ ) 
COMMON/CONST/AIN , AEX , RL , EXI , EYI , OMEGAX, OMEGAY , CFL , THETA , PO , TO , 

>CFL1 , PRNT , PB , RMl , SUM ( 4 ) , ZMUO , REN , PRN , TWALL , TREF 
>, BI0T,TW1 

C0MM0N/C0NST1/GAMMA(IZ, JZ) ,GM1(IZ, JZ) ,CP( IZ, JZ) ,CV( IZ, JZ) ,RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV , ITIME, IVISC,NORD, IWALL 

>  ,IWBC,IFLOW 

DIMENSION  RHO(IZ, JZ) ,RHOU(IZ, JZ),RHOV( IZ, JZ) , E( IZ, JZ) 
EQUIVALENCE(Q(1,1, 1),RH0(1, 1) ), (Q(l, 1,2) ,RHOU( 1, 1) ) , 

>  (Q(1,1,3),RH0V(1,1)), (Q(1,1,4),E(1,1)) 

(]^******:fr**Tlf***********llf*****Vr***Tfc'*************************'^*'i>r******* 

DATA  SCONST/196./ 

ENTRY  CLBC(II) 

I  =  II 

C  *  THE  QUANTITIES  EXTRAPOLATED  ARE  U,P,T  AND  LET  V=0 
C 

SY=SAIY(I, 1) 

EY=ETAY(I,1) 

DEN0M=SY-1 . 5*EY 

IF(I .NE.2.AND. I .LT. ILl )DENOM=DENOM+0 . 5*NORD*SY 

IF( I .EQ. 1 )THEN 

UIM1=0. 

PIM1=0. 

RIM1=1 .0 
ELSE 

UIM1=U( I-l, 1) 

PIM1=P( 1-1,1) 

RIM1=RH0( 1-1,1) 

END  IF 
V(I,1)=0. 

U(I, 1)=(SY*UIM1-0.5*EY*(4.*U(I,2)-U(I,3) ) )/DENOM 
IF( I .NE.2.AND. I .LT. ILl)  U( I , 1 )=U( I , 1 ) +NORD*SY* (U( 1-1,1)- 
*  0.5*U(I-2, 1) )/DENOM 

UN(I,1)=SAIX(I,1)*U(I,1) 

VN(I,1)=ETAX(I,1)*U(I,1) 

P(I,1)={SY*PIM1-0.5*EY*(4.*P(I,2)-P(I,3) ) )/DENOM 
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IF( I .NE.2 . AND. I .LT. ILl)  P( I, 1)=P(I, 1 ) +NORD*SY* ( P ( I - 1 , 1 ) - 
*  0.5*P( 1-2, 1) )/DENOM 

RIV=^1  .  /RGAS 
TIMl=-riMl/RIMl*RIV 
T2=P (1,2) /RHO( I , 2 ) *RIV 
T3^P( I , 3 )/RHO( I , 3 ) *RI V 
T1=(SY*TIM1-0.5*EY*(4. *T2-T3) )/DENOM 
I F ( I . NE . 2 . AND . I . LT . I  LI ) THEN 
TIM2=P( 1-2, l)/RHO( 1-2 , 1 )*RIV 
T1=T1+N0RD*SY* (TIMl-0. 5*TIM2)/DENOM 
ENDir 

CALL  CPGAM(CP( I , 1) ,CV( I , 1 ) , GAMMA( I , 1 ) , GMl ( I , 1 ) ,RGAS, I ,1, 

>  RHO (1,1), RHOU (1,1), RHO V (I,1),E(I,1),T1) 

RHO( I , 1)=P( I , 1)/T1*RIV 
RHOU (1,1) =RHO (I,1)*U(I,1) 

RHOV (1,1) =RHO (I,1)*V(I,1) 

E( I , 1)=P( I , 1 )/GMl( I , 1 )+0. 5*RH0( I, 1)*(U( I , 1 ) * *2 + V ( I , 1 ) * *2 ) 
RETURN 

ENTRY  WALLBC(II) 

I  =  II 
J=JL 

CC1=ETAX(I, J)*SAIX( I, J)+ETAY(I, J)*SAIY( I, J) 

CC2=ETAX( I , J)**2  +  ETAY( I  ,  J)**2 

I F ( I . NE . I L ) THEN 

AM=-0. 5*CC1 

BM--=1 . 5*CC2 

CM=0. 5’^CCl 

DM=CC2*(2.*P(I, J-1)-0.5*P(I, J-2)) 

ELSE 

AM=-CC1 

BM-CCl-t  1 . 5*CC2 
CM^O . 

DM=CC2*(2 . *P( I, J-l)-0. 5*P( I, J-2) ) 

END  IF 
IP1=I+1 

IF( I .EQ. IL) IP1=IL 

PSOL-(DM-AM*P( I-l, J)-CM*P( IPl, J) )/BM 
I F ( I . EQ . I L . AND . PB . NE . 0 . DO ) PSOL=PB 
RIV=1./RGAS 
IF( IWALL.EQ.O)THEN 

T1=P(I, J-1)*RIV/RH0( I, J-1) 

T2=P(I, J-2)*RIV/RH0( I,  J-2) 

DM=CC2* ( 2 . *Tl-0 . 5*T2 ) 

TIM1=P( I-l, J)*RIV/RHO( I-l, J) 

TIP1=P( IPl, J)*RIV/RHO( IPl,  J) 

TS0L=(DM-AM*TIM1-CM*TIP1 )/BM 
ELSE 
END  IF 

IF( IWALL.EQ.O)THEN 
TT=TSOL 
ELSE 

TT=TWALL 
END  IF 
PP=PSOL 
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U( I , JL)=C. 

V( I , JL)=0 . 

RHOU( I, JL)=0. 

RHOV( I, JL)=0. 

RHOO=PP*RIV/TT 
RHO(  I  ,  JL)=-RHOO 

CALL  CPGAM(CP( I , JL) ,CV( I , JL ) , GAMMA( I , JL ) , GMl ( I , JL) ,RGAS, I , JL, 

>  RHO ( I , JL ) , RHOU ( I , JL ) , RHOV ( I , JL ) , E ( I , JL ) , TT ) 

E(I,JL)  =PP/GM1( I, JL) 

P( I , JL)=PP 
UN( I , JL)=0. 

VN( I , JL)=0. 

RETURN 

C* 

C*  LAMINAR  VISCOSITY  CALCULATION 
C* 

C  ENTRY  MULAM(II) 

C  I  =  I  I 

C*  USE  SUTHERLAND  LAW 
C  DO  60  J=1,JL 

C  TOS=TREF+SCONST 

C  TT= ( E ( I , J ) /RHO (I,J)-0.5*{U(I,J)**2+V{I,J)**2)) /CV ( I , J ) 

C  TTS=TT+SCONST 

C  ZMU(  I  ,  J)=ZMU0*T0S/TTS*  (TT/TREF)’^*1 . 5 

C  ZrW(  I  ,  J)=ZMU0 

C  ZMU( I , J)=ZMU0*(TT/TREF)**0. 67 

C  60  CONTINUE 
C  RETURN 

END 

SUBROUTINE  MULAM(NN) 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( I Z=150 , JZ=80 ) 

COMMON/VECTOR/DQ( IZ, JZ,4) ,Q( IZ,JZ,4),F(IZ,JZ,4),G(IZ,JZ,4), 

>  P( IZ, JZ) ,U( IZ, JZ) ,V(IZ, JZ) ,UN( IZ, JZ) ,VN{ IZ, JZ) 
COMMON/COORD/SAIX( IZ, JZ) , SAIY( IZ, JZ) , ETAX( IZ, JZ) , ETAY( IZ, JZ) 

>  ,ZMUT( JZ) ,RJ( IZ, JZ) ,X( IZ, JZ),Y(IZ, JZ) ,DELTAU( IZ, JZ) 

>  , AREA( IZ) ,ZMU( IZ, JZ) ,A1( IZ, JZ),A2(IZ, JZ; ,A3(IZ, JZ) ,A4(IZ, JZ) 
COMMON/CONST/A I N , AEX , RL , EX I , EYI , OMEGAX ,  , MEGAY , CFL , THETA , PO , TO , 

>CFL1 , PRNT, PB,RM1, SUM(4) , ZMUO , REN, PRN, TWALL, TREF 
>, BI0T,TW1 

COMMON/CONST 1 /GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , CP ( I Z , JZ ) , CV ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND , NBEG, NADV , ITIME, IVISC,NORD, IWALL 

>  ,IWBC,IFLOW 

DIMENSION  RHO( IZ, JZ) , RHOU( IZ, JZ) ,RHOV( IZ , JZ ) , E ( IZ , JZ ) 

EQU I VALENCE { Q ( 1 , 1 , 1 ) , RHO (1,1)),(Q(1,1,2), RHOU (1,1)), 

>  (Q(l, 1,3),RH0V(1,1) ), (Q(l, 1,4),E(1, 1) ) 

^★★★★★★•;i^^**rfe*Tif*4'Ttr****4'**^r*^**^Tt’^*ilr*ifcr  +  ***Tlr****  +  yp***Slr****T'f*ilp**:^*Tfc’*ilr** 

Bl=4. 3222557667160623D-06 
B2=3 . 8885996244952953D-08 
B3=-3 . 7263546610032919D-12 
C  DO  50  NN=1,IL 

DO  50  MM=1,JL 

TT^(E(NN,MM)/RHO(NN,MM)-0. 5* (U(NN,MM)**2+V(NN,MM)**2) )/CV(NN,MM) 
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ZMU(NN,MM)=B1+B2*TT+B3*TT*TT 
50  CONTINUE 
RETURN 
END 


BOLDWIN  &  LOMAX  TURBULENCE  MODEL 
SUBROUTINE  MUTUR(:i) 

Q**************************************************************** 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( I Z=150 , JZ=80 ) 

COMMON/VECTOR/DQ(IZ, JZ,4) ,Q(IZ, JZ,4),F(IZ, JZ,4) ,G(IZ, JZ,4) , 

>  P(IZ, JZ),U(IZ, JZ),V(IZ, JZ),UN(IZ, JZ),VN(IZ, JZ) 
COMMON/COORD/SAIX ( I Z , JZ ) , SAI Y ( I Z , JZ ) , ETAX ( I Z , JZ ) , ETAY ( I Z , JZ ) 

>  , ZMUT( JZ) ,RJ( IZ, JZ) ,X( IZ, JZ) , Y( IZ, JZ ) , DELTAU( IZ, JZ) 

>  , AREA( IZ) , ZMU{ IZ, JZ) , Al( IZ, JZ) , A2( IZ, JZ) , A3{ IZ, JZ) ,A4( IZ, JZ) 
COMMON/CONST/A I N , AEX , RL , EX I , EYI , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 

>CFL1,PRNT,PB,RM1, SUM(4) , ZMUO , REN, PRN, TWALL, TREF 
>,BI0T,TW1 

COMMON/CONST 1/GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , CP ( I Z , JZ ) , CV ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV, ITIME, IVISC,NORD, IWALL 

>  ,IWBC,IFLOW 

DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ) ,RHOV( IZ, JZ) , E( IZ, JZ) 
EQUIVALENCE(Q(1, 1,1),RH0(1,1)), (Q(l, 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(1,1,3),RH0V(1,1)), (Q(1,1,4),E(1,1)) 

C**************************************************************** 

DIMENSION  YVERT(JZ),ZMUI(JZ) 

DATA  AP,CCP,CKLEB,CWK,VKC0N,XK/26. ,  1.6,  .3,  .25,  .4,  .0168/ 

DATA  ZMUI/JZ*0.0/ 

I  =  II 

FYMAX  =0.0 
YMAX  =0.0 
UDIF=0. 

YVERT(JL)  =0.0 

TAUW  =  ZMU(I,  JL)*DABS(ETAY(I, JL)*(U(I, JL)-U(I, JL-1) )- 

>  ETAX(I, JL)*(V(I, JL)-V(I, JL-1) )) 

CYP  =  DSQRT(RHO(I, JL)*TAUW)/ZMU(I, JL) 

C 

DO  10  KK  =  2, JLl 
K  =  JL+l-KK 

YVER  =  YVERT(K+1)  +  1 . 0/DSQRT( ETAX ( I , K ) * *2  +  ETAY( I , K) **2 ) 

OMG  =  DABS(  ETAY(I,K)*(U(I,K+1)-U(I,K-1))*.5 

>  +SAIY(I,K)*(U(I,K)  -U(I-1,K)) 

-ETAX( I,K)*(V( I,K+1)-V( I,K-1) )*.5 

>  -SAIX{I,K)*(V(I,K)  -V(I-1,K))  ) 

YPLUS  =  CYP* YVER 

TURLEN  =  VKCON*YVER* ( 1 . ODO  -DEXP ( -YPLUS/AP ) ) 

ZMUI(K)  =  RHO( I ,K)*OMG*TURLEN**2 
FY  =  TURLEN/VKCON*OMG 
UTOTAL=  DSQRT(U( I ,K)**2+V( I ,K)**2) 

IF(UTOTAL.GE.UDIF)  UDIF=UTOTAL 
IF(FY  .LT.  FYMAX)  GO  TO  10 
FYMAX  =  FY 

YMAX  =  YVER 

10  YVERT{K)  =  YVER 
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C 

VXDIF  =  UDIF 

FW AKE 1 = YMAX * F YMAX 

FWAKE2 ^CWK* YMAX* VXD I F* * 2/FYMAX 

FWAKE  =DMIN1{FWAKE1,FWAKE2) 

C 

DO  20  KK  =  2,  JLl 
K  JL+l-KK 

FKLEB  =  (CKLEB*YVERT(K)/YMAX)**6 

FKLEB  =  l./(1.0  +  5.5*FKLEB) 

ZMUO  =  XK*CCP*RHO(I,K)*FWAKE*FKLEB 

IF(2MUI (K) .GT. ZMUO)  THEN 
ZMUTUR  =  ZMUO 
ELSE 

ZMUTUR  =  ZMUI(K) 

END  IF 

ZMUT(K)=  ZMUTUR 

ZMU(I,K)  =  ZMU(I,K)  +  ZMUTUR 

C  WRITE (77, 119)K,Y(I,K) , YVERT( K) , U( I , K) , ZMUI ( K ) , ZMUO, ZMU( I , K) 

C119  FORMAT(2X, I3,6(2X,D13.6)) 

20  CONTINUE 
C 

ZMUT(1)=0. 

ZMUT( JL)=0. 

RETURN 

END 

C*  SUORCE  TERM  JACOBIAN  MATRIX 
SUBROUTINE  DHDQ(D,I,J) 

C - 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( I Z=150 , JZ=80 ) 

COMMON/VECTOR/DQ(IZ, JZ,4),Q(IZ, JZ,4),F(IZ, JZ,4),G(IZ, JZ,4), 

>  P( IZ, JZ) ,U( IZ, JZ),V(IZ, JZ) ,UN(IZ, JZ) ,VN(IZ, JZ) 
COMMON/COORD/SA IX(IZ,JZ),SAIY(IZ,JZ), ETAX ( I Z , JZ ) , ETAY ( I Z , JZ ) 

>  , ZMUT( JZ) ,RJ( IZ, JZ),X( IZ, JZ),Y(IZ, JZ) ,DELTAU( IZ, JZ) 

>  , AREA( IZ) ,ZMU( IZ, JZ) , Al( IZ, JZ) ,A2( IZ, JZ) , A3( IZ, JZ) , A4( IZ, JZ) 
COMMON/CONST/A I N , AEX , RL , EX I , EY I , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 

>CFL1,PRNT,PB,RM1, SUM(4) , ZMUO , REN, PRN, TWALL, TREF 
>,BI0T,TW1 

COMMON/CONST 1/GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , CP ( I Z , JZ ) , CV ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV, ITIME, IVISC,NORD, IWALL 

>  ,IWBC,IFLOW 

DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ) ,RHOV( IZ, JZ) , E( IZ, JZ) 

EQUIVALENCE (Q( 1, 1, 1) ,RHO( 1, 1) ) , ( Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(l, 1,3),RH0V(1,1)), (Q(1,1,4),E(1,1)) 

ic  ie  if  ie  k  -k  -k  iv  -k  "k  it  -k  -k  'k  ie  ir  -k  it  if  it  •/(  ic  it  "k  -k  ic  "k  'k  it  -k  ir  ir  ie  ie  ic  ie  'k  "k  i(  "k  •k  "k  "k  ie  ic  ic  ie  ie  ie  it  -k  ic  if  ie  ie  -k  "k  ie  ic  ic  if  it 

DIMENSION  D(4,4) 

CALL  SZER0(4,D) 

IF( IVISC. EQ. 0)THEN 
R2MY=0. 

ELSE 

R2MY=4./3.*ZMU(I, J)/(Y(I, J)*Y(I, J)*RHO(I, J)) 

END  IF 

D(3, 1;^. 5*GM1( I, J)*(U( I, J)**2+V( I, J)**2)/Y( I, J)+IVISC*V( I, J)*R2MY 
D(3,2)=-GM1(I, J)*U(I, J)/Y(I, J) 
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D(3,3)=-GM1(I, J)*V(I, J)/Y(I, J)-IVISC*R2MY 
D{3,4)=GM1(1, J)/Y(I, J) 

RETURN 

END 

SUBROUTINE  JACCAL 
C* 

C*  SUBROUTINE  FOR  JACOBIAN  METRIX 
C*  IF  IA=1,  ACAP  MATRIX 
C*  IF  IA=2,  BCAP  MATRIX 
C* 

it  ie  it  it  -k  'k  -k  'k  -k  ^  ie  -k  -k  -k  -k  -k  ir  ic  -k  -k -k  ie  "k  -k  -k  ic  "k  'k  ie 'k  ic  -k  ie  ic -k -k -k  ie  ie  -k  "k  -k  -k  -k  -k  "k  ic  i:  ic -k  if  "k  -k  "k  ie 'k  ie  "k  ic  -k  it -k 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( IZ=150 , JZ=80 ) 

COMMON/VECTOR/DQ(IZ, JZ,4),Q(IZ, JZ,4),F(IZ, JZ,4),G(IZ, JZ,4), 

>  P( IZ, JZ) ,U( IZ, JZ) , V( IZ, JZ) ,UN( IZ, JZ) , VN( IZ, JZ) 
COMMON/COORD/SA IX{IZ,JZ),SAIY(IZ,JZ), ETAX ( I Z , JZ ) , ETAY ( I Z , JZ ) 

>  ,ZMUT(JZ),RJ(IZ, JZ),X(IZ, JZ),Y(IZ, JZ),DELTAU(IZ, JZ) 

>  , AREA( IZ) , ZMU( IZ, JZ) , Al( IZ, JZ) , A2( IZ, JZ) , A3( IZ, JZ) ,A4( IZ, JZ) 
COMMON/CONST/A I N , AEX , RL , EX I , E Y I , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 

>CFL1 , PRNT , PB , RMl , SUM ( 4 ) , ZMUO , REN , PRN, TWALL , TREF 
>,BI0T,TW1 

COMMON/CONST 1 /GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , CP ( I Z , JZ ) , CV ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, ILl , JLl , NENT), NBEG, NADV, ITIME, IVISC,NORD, IWALL 

>  ,IWBC,IFLOW 

DIMENSION  RHO( IZ, JZ) , RHOU( IZ, JZ) , RHOV( IZ, JZ) ,E( IZ, JZ) 
EQUIVALENCE(Q(1, 1, 1) ,RH0(1,1) ) , (Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(1,1,3),RH0V(1,1)), (Q( 1,1,4), E( 1,1)) 

Q******************************************************************* 

DIMENSION  A(4,4) ,B(4,4) ,C(4,4),TEMP(4,4) ,BB(4,4) ,DIAG(4) 

Q****  ************************************************************** 

ENTRY  JAC0B(IA,A, I, J) 

IF( IA.EQ.2)G0  TO  10 
CX=SAIX( I , J) 

CY=SAIY( I , J) 

CONTRA=UN(I, J) 

GO  TO  20 
10  CX=ETAX(:,J) 

CY=ETAY( I, J) 

CONTRA=VN( I , J) 

20  CONTINUE 

PHI2=0.5*GM1(I, J)*(U( I, J)**2+V(I, J)**2) 

A(l, 1)=0.0D0 
A ( 1 , 2 ) =CX 
A(1,3)=CY 
A( 1, 4)=0.D0 

A ( 2 , 1 ) =CX*PHI 2 -U ( I , J ) *CONTRA 
A ( 2 , 2 ) =CONTRA- ( GAMMA ( I , J ) -2 . ) *CX*U ( I , J ) 

A(2,3)=CY*U(I, J)-GM1(I, J)*CX*V(I, J) 

A(2,4)=^GM1(I,  J)*CX 

A(3, 1)=CY*PHI2-V( I , J)*CONTRA 

A(3,2)=CX*V(I, J)-GM1( I, J)*CY*U(I, J) 

A ( 3 , 3 ) =CONTRA-CY* V ( I , J ) * ( GAMMA ( I , J ) - 2 . ) 

A(3,4)=GM1(I, J)*CY 

A(4, l)=CONTRA*(2.*PHI2-GAMMA(I, J)*E(I, J)/RHO(I, J) ) 
A(4,2)=CX*(GAMMA(I, J)*E(I, J)/RHO(I, J)-PHI2)-GM1(I, J)*CONTRA 
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>  *U(I,J) 

A(4,3)=CY*(GAMMA(I, J)*E(I, J)/RHO(I, J)-PHI2)-GM1(I, J)*CONTRA 

^  *V(I,J) 

A ( 4 , 4 ) =GAMMA ( I , J ) *C0NTRA 
RETURN 
C* 

C*  SPLITTED  JACOBIAN  MATRIX  IN  XI -DIRECTION 
C* 

ENTRY  A JACOB ( I A, A, I, J) 

C* 

C*  FOR  THE  FIRST  ITERATION  TURN  OFF  A  MINUS 

C* 

IF(NADV.EQ. l.AND. IA.EQ.2)  THEN 
CALL  SZER0(4,A) 

RETURN 
END  IF 

C  WRITE (6,*)  I,J,RHO(I,J) 

CO-DSQRT(GAMMA(I, J)*P(I, J)/RHO(I, J) ) 

CX=DSQRT(SAIX(I, J)**2+SAIY(I. J)**2) 

CXC0=CX*C0 
EIG1=UN( I , J) 

EIG2=UN(I, J) 

EIG3=UN( I, J)+CXC0 
EIG4=UN( I , J)-CXC0 
IF( lA.EQ. 1 ) THEN 
DIAG(1)=0.5*(EIG1+DABS(EIG1) ) 

DIAG(2)=DIAG(1) 

DIAG(3)=0.5*(EIG3+DABS(EIG3) ) 
nrAr;(4)=0. 5*(EIG4+DABS(EIG4)  ) 

ELSE 

DIAG(1)=0.5*(EIG1-DABS(EIG1)) 

DIAG(2)=DIAG(1) 

DIAG(3)=0. 5*(EIG3-DABS(EIG3) ) 

DIAG(4)=0. 5*(EIG4-DABS(EIG4) ) 

END  IF 

CALL  EIGEN(1,BB, I, J) 

DO  40  II-l,** 

DO  40  JJ=1,4 

TEMP( II , JJ)=DIAG( II )*BB( II , JJ) 

40  CONTINUE 

CALL  EIGAR(BB, I , J) 

CALL  MMM{4,BB,TEMP, A) 

RETURN 

C* 

C*  TRUE  JACOBIAN  FOR  DE+-/DQ 
C* 

ENTRY  TRUEJ( IA,A, I, J) 

C  CHECK  THE  FOURTH  EIGEN  VALUE 

CO=DSQRT(GAMMA( I, J)*P( I, J)/RHO(I, J) ) 

CX=DSQRT(SAIX( I, J)**2+SAIY(I, J)**2) 

CXC0=CX*C0 
EIG4=UN(I, J)-CXC0 
IF(UN(I, J) .LT.O.DO)GOTO  60 
IF(EIG4. LT.O.DO)GOTO  50 
C 
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IF( lA.EQ. 1)THEN 
CX=SAIX( I , J) 

CY=SAIY(I, J) 

CONTRA=UN(I, J) 

PHI2=0.5*GM1(I, J)*(U(I, J)**2+V(I, J)**2) 

A(l, 1)=0.0D0 
A( 1, 2 )=CX 
A(1,3)=CY 
A(1,4)-^0.D0 

A(2, 1 )=CX*PHI2-U{ I , J)*CONTRA 
A ( 2 , 2 ) =C0NTRA- ( GAMMA ( I , J ) - 2 . ) *CX*U ( I , J ) 

A(2,3)=CY*U(I, J)-GM1(I, J)*CX*V(I, J) 

A(2,4)=GM1(I, J)*CX 

A(3, 1)=CY*PHI2-V( I, J)*CONTRA 

A(3,2)=CX*V(I, J)-GM1(I, J)*CY*U(I, J) 

A ( 3 , 3 ) =C0NTRA-CY* V ( I , J ) * ( GAMMA ( I , J ) -2 . ) 

A(3,4)=GM1(I, J)*CY 

A(4, l)=CONTRA*(2.*PHI2-GAMMA(I, J)*E(I, J)/RH0(I, J) ) 

A ( 4 , 2  ^  =CX* ( GAMMA ( I , J ) *  E ( I , J ) /RHO (I,J)-PHI2)-GM1(I,J) *CONTRA 

>  *U( I, J) 

A(4,3)=CY*(GAMMA(I, J)*E(I, J)/RHO(I, J)-PHI2)-GM1(I, J)*CONTRA 

>  *V(I,J) 

A(4, 4)=:GAMMA{  I ,  J)*CONTRA 
ELSE 

CALL  SZER0(4,A) 

END  IF 
RETURN 
C 

50  CONTINUE 

IF(NADV.EQ. l.AND. IA.EQ.2)THEN 
CALL  SZERO(4,A) 

RETURN 

ELSE 

PHI2=0.5*GM1(I, J)*(U( I, J)**2+V(I, J)**2) 

ERC=E{ I, J)/RHO( I, J)/C0 
ECR=E ( I , J ) *CO/RHO ( I , J ) 

R1=SAIX(I, J) 

R2=SAIY(I, J) 

R1T=R1/CX 

R2T=R2/CX 

G2M2= ( 2 . *GAMMA{ I , J ) - 1 . ) * • 5/GAMMA( I , J ) 

G23G=(-GAMMA( I , J)**2+3 . *GAMMA( I , J)-l . )* . 5/GAMMA( I , J) 

G34G=( 3 . *GAMMA( I , J) -2 . ) * • 25/GAMMA( I , J) 

GM12=GM1( I , J)**2* . 5/GAMMA( I, J) 

CGEC=C0*.5/GAMMA(I, J)-0.25*GM1(I, J)*ERC 
RKUU=CX*U(I, J)+R1T*UN(I, J) 

RKVU=CX* V ( I , J ) +R2T*UN ( I , J ) 

U2V2=PHI2/GM1 ( I , J) *2 . 

RKU2=.25*GM1( I , J)*(CX* .5*U2V2+UN( I , J)**2/CX) 

C 

IF( lA.EQ. 1)THEN 
A(l, 1)=.25*GM1(I, J)*CX*ERC 
A(1,2)=G2M2*R1-.25*GM1(I, J)*CX*U(I, J)/C0 
A(1,3)=G2M2*R2-.25*GM1(I, J)*CX*V(I, J)/C0 
A(1,4)=.25*GM1(I, J)*CX/C0 
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A(2, 1)=-G2M2*U( I , J)*UN( I, J)+.5*R1*PHI2-CGEC*RKUU 

A(2,2)=G23G*R1*U( I, J)+G2M2*UN(I, J)+.5*(CX+R1*R1T)/GAMMA(I, J)*C0- 

>  0.25*GM1(I, J)*U(I, J)/C0*RKUU 
A(2,3)=G2M2*R2*U( I, J)-.5*GM1(I, J)*R1*V(I, J)+.5*R1T*R2 

>  /GAMMA(I, J)*C0-0.25*GM1(I, J)*V(I, J)/C0*RKUU 
A(2, 4)=.5*GM1( I, J)*R1+.25*GM1( I, J)*RKUU/C0 

A ( 3 , 1 ) ^-G2M2*V( I , J ) *UN( I , J ) +0 . 5*R2*PHI2-CGEC*RKVU 
A(3,2)=G2M2*R1*V(I, J)-.5*GM1(I, J)*R2*U(I, J)+0.5*R1*R2T 

>  /GAMMA ( I , J ) *C0-0 . 25*GM1 ( I , J ) *U( I , J)/C0*RKVU 

A( 3 , 3 ) =G2M2*UN( I , J ) +G23G*R2*V( I , J ) + ( CX+R2T*R2 ) * . 5/GAMMA( I , J ) *C0- 

>  0.25*GM1(I, J)*V(I, J)/C0*RKVU 

A(3 , 4)=. 5*GM1( I , J)*R2+ . 25*GM1( I , J)*RKVU/C0 

A(4, 1)=GM12*UN(I, J)*U2V2-.5*GAMMA(I, J)*UN(I, J)*E(I, J) 

>  /RH0( I , J)+CX/GAMMA( I , J ) *PHI2*C0-UN( I , J ) **2*C0/GAMMA( I , J)/CX 

>  - .25*CX*ECR+RKU2*ERC 

A(4,2)=-GM12*U(I,  J)*UN(  I,  J)+'.5*R1*GAMMA(I,  J)*E(I,  J)/RH0(I,  J) 

>  -GMl ( I , J)* . 5/GAMMA( I , J)*R1*PHI2-G34G*CX*U( I , J)*C0+R1T 

>  /GAMMA( I , J) *UN( I , J ) *C0-RKU2*U( I ,J)/C0 
A(4,3)=-GM12-V( I, J)*UN( I , J ) + . 5*R2*GAMMA( I , J ) *E ( I , J )/RH0( I , J ) 

>  -GMl ( I , J) * . 5/GAMMA ( I , J)*R2*PHI2-G34G*CX*V( I , J)*C0+R2T 
^  /GAMMA(  I,  J)*UNn,  J)*C0-RKU2*V(I,  J)/C0 

A(4,  4)  =  .  B^GAMMAH/ J)*UN{  I,  J)  +  .75*CX*C0+RKU2/C0 
ELSE 

G1 1G=  ( 1  .  -t  GAMMA(  I ,  J )  -GAMMA (  I ,  J  )  **2  )  *  .  5/GAMMA(  I ,  J  ) 

G22M=(GAMMA( I, J)**2-l. ) * . 5/GAMMA( I , J ) 

A(l, 1)=-.25*GM1(I, J)*CX*ERC 

A(1,2)=.5/GAMMA(I, J)*R1+.25*GM1(I, J)*CX*U(I, J)/C0 
A(1,3)=,5/GAMMA(I, J)*R2+.25*GM1(I, J)*CX*V(I, J)/C0 
A( 1, 4)=- . 25*GM1( I , J)*CX/C0 

A(2, 1)=- . 5/GAMMA( I , J ) *U( I , J ) *UN( I , J ) + . 5*R1*PHI2+CGEC*RKUU 
A(2,2)=G11G*R1*U(I, J)+.5/GAMMA(I, J)*UN(I, J)-.5*(CX+R1*R1T) 

>  /GAMMA(I, J)*C0+0.25*GM1( I, J)*U(I, J)/C0*RKUU 

A(2,3)=. 5/GAMMA( I, J)*R2*U(I, J)-.5*GM1(I, J)*R1*V(I, J)-.5*R1T*R2 

>  /GAMMA(  I  ,  J)*C0  +  0.25*GM1(  I,  J)*V'(I,  J)/CC*RKUU 
A{2,4)=.5*GM1(I, J)*R1-.25*GM1(I, J)*RKUU/C0 

A(3, 1 )=- . 5/GAMMA( I , J)*V( I , J)*UN( I , J ) +0 . 5*R2*PHI2+CGEC*RKVU 
A(3,2)=.5/GAMMA( I, J)^R1*V(I, J)-.5*GM1(I, J)*R2*U(I, J)-0.5*R1*R2T 

>  /GAMMA ( 1 , J) *C0+0. 25*GM1 ( I , J)*U( I , J)/C0*RKVU 

A(3,3 )=. 5/GAMMA( I, J)*UN( I , J ) +G11G*R2*V( I , J ) - ( CX+R2T*R2 ) * . 5 

>  /GAMMA ( I , J)*C0+0.25*GM1( I, J)*V(I, J)/C0*RKVU 
A(3, 4)=. 5*GM1( I, J)*R2- . 25*GM1 ( I , J ) *RKVU/C0 

A(4, 1 )=G22M*UN( I , J)*U2V2- . 5*GAMMA( I , J ) *UN ( I , J ) *E( I , J)/RH0( I , J)- 

>  CX/GAMMA( I , J)*PHI2*C0+UN( I , J ) **2*C0/GAMMA( I , J)/CX 

>  +.25*CX*ECR-RKU2*ERC 

A(4,2)=-G22M*U(I, J)*UN( I, J)+.5*R1*GAMMA(I, J)*E(I, J)/RH0(I, J) 

>  - (GAMMA( I , J ) +1 . ) * • 5/GAMMA( I , J ) *R1*PHI2+G34G*CX*U( I , J ) 

>  -^CO-RlT/GAMMAi  I  ,  J)*UN(  I  ,  J )  *C0+RKU2*U(  1 ,  J)/CO 

A(4, 3)--G22M*V( I, J)*UN( I , J ) + . 5*R2*GAMMA( I , J ) *E ( I , J ) /RHO( I , J ) 

>  -(GAMMA(I, J)+l. )*.5/GAMMA(I, J)*R2*PHI2+G34G*CX*V(I, J) 

>  *C0-R2T/GAMMA( I , J)*UN( I , J ) *C0+RKU2*V( I , J)/CO 
A(4, 4)=. 5*GAMMA( I , J ) *UN( I , J ) - . 75*CX*C0-RKU2/C0 
END  IF 

ENDIF 

RETURN 

60  CONTINUE 
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C* 

C*  REVERSE  FLOW  REGION 

C* 

I F ( NADV . EQ . 1 )  THEN 
WRITE(6, 1010) 

1010  FORMAT ( '  ***  REVERSE  FLOW  FOR  PNS  MARCHING  ***') 

RETURN 
END  IF 

EIG3=UN( I , J)+CXC0 
IF(EIG3 .LT.0.D0)THEN 
IF( lA.EQ. 1)THEN 
CALL  SZER0(4,A) 

RETURN 

ELSE 

CX=SAIX( I , J) 

CY=SAIY(I, J) 

CONTRA=UN(I, J) 

PHI2=0.5*GM1( I, J)*(u(I, J)**2+V(I, J)**2) 

A(l, 1)=0.0D0 
A( 1, 2 )=CX 
A(1,3)=CY 
A(1,4)=0.D0 

A(2, 1 )=CX*PHI2-U( I , J)*CONTRA 
A ( 2 , 2 ) =CONTRA- ( GAMMA ( I , J ) -2 . ) *CX*U ( I , J ) 

A(2,3)=CY*U(I, J)-GM1(I, J)*CX*V(I, J) 

A(2,4)=GM1(I, J)*CX 

A(3, 1)=CY*PHI2-V(I, J)*CONTRA 

A(3,2)=CX-*V(  I ,  J)-GM1(  I,  J)*CY*U(I,  J) 

A( 3 , 3 )=CONTRA-CY*V( I , J ) * (GAMMA( I , J ) -2 . ) 

A(3,4)=GM1(I, J)*CY 

A(4, l)=CONTRA*(2.*PHI2-GAMMA(I, J)*E(I, J)/RHO( I, J) ) 

A ( 4 , 2 ) =CX  * ( GAMMA (I,J)*E(I,J) /RHO (I,J)-PHI2)-GM1(I,J)*  CONTRA 

>  *U( I , J) 

A ( 4 , 3 ) =CY* ( GAMMA (I,J)*E(I,J) /RHO (I,J)-PHI2)-GM1(I,J) *CONTRA 

>  *V(I,J) 

A(4, 4)=GAMMA( I , J)*CONTRA 
RETURN 
END  IF 
END  IF 
C 

PHI2=0.5*GM1(I, J)*(U(I, J)**2+V(I, J)**2) 

ERC=E( I, J)/RHO( I , J)/C0 
ECR=E(I, J)*CO/RHO(I, J) 

R1=SAIX( I , J) 

R2=SAIY(I, J) 

R1T=R1/CX 

R2T=R2/CX 

G2M2= ( 2 . *GAMMA ( I , J ) - 1 . ) * ■ 5/GAMMA ( I , J ) 

G23G=( -GAMMA ( I , J)**2+3 . *GAMMA( I , J ) - 1 . )* . 5/GAMMA( I , J) 

G3  4G= ( 3 . *  GAMMA (I,J)-2.)*.25 /GAMMA ( I , J ) 

GM12=GM1(I, J)**2*.5/GAMMA(I, J) 

CGEC=C0* . 5/GAMMA( I , J ) -0 . 25*CM1 ( I , J ) *ERC 
RKUU=CX*U( I , J)+R1T*UN( I , J) 

RKVU=CX*V( I, J)+R2T*UN( I, J) 

U2V2=PHI2/GM1 ( I , J) *2  . 
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RKU2=.25*GM1( I , J ) * ( CX* . 5*U2V2+UN( I , J ) * *2/CX ) 

G1 1G=( 1 . +GAMMA( I , J ) -GAMMA ( I , J) **2 ) * . 5/GAMMA( I , J ) 

G22M=(GAMMA( I , J) **2-1 . ) * . 5/GAMMA( I , J) 

IF(  lA.EQ.  DTHEN 

A( 1, 1)=. 25*GM1( I , J)*CX*ERC 

A(l,  2  )=^0. 5/GAIvlMA(  I ,  J  )  *R1-  .  25*GM1  (  I ,  J  )  *CX*U(  I ,  J)/C0 
A ( 1 , 3 ) =0 . 5/GAMMA ( I , J ) *R2 - . 2  5*GM1 ( I , J ) *CX* V( I , J ) /CO 
A(1,4):=.2  5*GM1(I,  J)*CX/CO 

A( 2 , 1 ) =-0 . 5/GAMMA( I , J ) *U( I , J ) *UN( I , J ) + . 5*R1*PHI2-CGEC*RKUU 
A(2,2)^G11G*R1*U(I, J)+0.5/GAMMA(I, J)*UN(I, J)+.5*(CX+R1*R1T) 

>  /GAMMA( I, J)*C0-0.25*GM1( I, J)*U(I, J)/CO*RKUU 
A(2,3)=0.5/GAMMA(I, J)*R2*U(I, J)-.5*GM1(I, J)*R1*V(I, J)+.5*R1T*R2 

>  /GAMMA(I. J)*C0-0.25*GM1( I , J) *V( I , J)/CO*RKUU 
A(2,4)=.5*GM1( I, J)*R1+.25*GM1(I, J)*RKUU/CO 

A(3, l)=-0. 5/GAMMA ( I , J)*V( I , J ) *UN( I , J ) +0 . 5*R2*PHI2-CGEC*RKVU 
A(3,2 )=0. 5/GAMMA( I , J)*R1*V( I , J ) - . 5*GM1 ( I , J)*R2*U( I , J)+0. 5*R1 

>  *R2T/GAMMA( I , J ) *C0-0 . 25*GM1 ( I , J)*U( I , J)/CO*RKVU 

A ( 3 , 3 ) =0 . 5/GAMMA ( I , J ) *UN ( I , J ) +G11G*R2  * V ( I , J )  +  ( CX+R2T*R2 ) * . 5 

>  /GAMMA ( I , J)*C0-0.25*GM1( I, J)*V(I, J)/CO*RKVU 
A(3,4)=.5*GM1(I, J)*R2+ . 25*GM1 ( I , J ) *RKVU/CO 

A(4, 1)=G22M*UN( I, J)*U2V2- .5*GAMMA(I, J)*UN(I, J)*E{I, J)/RHO(I, J)+ 

>  CX/GAMMA( I , J)*PHI2*C0-UN( I , J ) * *2*C0/GAMMA( I , J)/CX- .25 

>  *CX*ECR+RKU2*ERC 

A(4, 2 )=-G22M*U( I , J ) *UN ( I , J ) + . 5*R1*GAMMA ( I , J ) *E ( I , J )/RH0( I , J ) 

>  -(GAMMA( I, J)+l . )*.5/GAMMA(I, J)*R1*PHI2-G34G*CX*U(I, J) 

>  *C0+R1T/GAMMA( I , J ) *UN( I , J ) *C0-RKU2*U( I , J)/CO 
A(4,3)=-G22M*V(I, J)*UN(I, J)+.5*R2*GAMMA(I, J)*E(I, J)/RHO(I, J) 

>  -(GAMMA(I, J)+l. )* . 5/GAMMA(I, J)*R2*PHI2-G34G*CX*V(I, J) 

>  *C0+R2T/GAMMA( I , J)*UN( I , J ) *CC-RKU2*V( I , J)/CO 
A(4, 4)=. 5*GAMMA( I , J)*UN( I , J ) + . 75*CX*C0+RKU2/C0 
ELSE 

A( 1, 1 , 25*GM1( I , J)*CX*ERC 
A(1,2)^G2M2*R1+.25*GM1( I , J ) *CX*U( I , J ) /CO 
A(1,3)=G2M2*R2*.25*GM1(I, J)*CX*V(I, J)/CO 
A(1,4)=-.25*GM1(I, J)*CX/CO 

A(2, 1)=-G2M2*U( I , J)*UN( I , J ) + . 5*R1*PHI2+CGEC*RKUU 

A(2,2 )=G23G*R1*U( I , J) +G2M2*UN( I , J)- . 5* ( CX+R1*R1T )/GAMMA( I , J) 

>  *C0+0.25*GM1( I, J)*U( I , J)/CO*RKUU 
A(2,3)=G2M2*R2*U(I, J)-.5*GM1(I, J)*R1*V(I, J)-.5*R1T*R2 

>  /GAMMA( I , J)*C0+0. 25*GM1 ( I , J ) *V( I , J )/CO*RKUU 
A(2,4)=.5*GM1(I, J)*R1-.25*GM1(I, J)*RKUU/CO 

A(3, 1 )=-G2M2*V( I , J)*UN( I , J ) +0 . 5*R2*PHI2+CGEC*RKVU 
A(3, 2 )=G2M2*R1*V( I , J)- . 5*GM1 ( I , J ) *R2*U{ I , J ) -0 . 5*R1*R2T 

>  /GAMMA(  I,  J)*C0-t-0.25*GMl(  I,  J)*U(I,  J)/CO*RKVU 

A(3 , 3 )=G2M2*UN( I , J ) +G23G*R2*V( I , J) - (CX+R2T*R2 ) * . 5/GAMMA( I , J ) *C0+ 

>  0. 25*GM1 ( I , J)*V( 1 , J)/CO*RKVU 
A(3,4)=.5*GM1( I , J)*R2-.25*GM1(I, J)*RKVU/CO 

A (4, 1)^GM12*UN( I , J)*U2V2-.5*GAMMA( I, J)*UN( I, J)*E( I, J) 

>  /RHO(  I  ,  J  )  -CX/GAMMA(  I  ,  J  )  *PHI2*C0  '■UN(  I ,  J  )  **2*C0/GAMMA(  I ,  J)/CX+  .  25 

>  *CX*ECR-RKU2*ERC 

A(4,2)=-GM12*TJ(I,  J)*UN(  I  ,  J  )  +  .  5*R1*GAMMA(  I ,  J )  *E  ( I ,  J ) /RHO(  I  ,  J ) 

>  -GM1( I , J)* . 5/GAMMA ( I , J) *R1*PHI2+G34G*CX*U( I , J)*C0-R1T 

>  /GAMMA ( I , J)*UN( T , J ) *C0+ RKU2*U( I , J )/C0 

A(4, 3 )--nM12*V( I , J)*UM( I, J)+.5*R2*GAMMA{ I, J)*E( I, J)/RHO( I, J) 
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>  -GM1( I , J)* . 5/GAMMA( I , J) *R2*PHI2+G34G*CX*V( I , J)*C0-R2T 

>  /GAMMA ( I , J) *UN( I , J) *C0+RKU2*V( I , J)/C0 

A ( 4 , 4 )  =  . 5*GAMMA( I , J ) *UN( I , J ) -  - 75*CX*C0-RKU2/C0 
END  IF 
RETURN 
C* 

C*  VISCOUS  TERM  JACOBIAN  MATRIX 
C* 

ENTRY  VJACOB(A,B,C, I, J) 

JP1=J+1 

JM1=J-1 

ZMUP=0 . 5* (ZMU( I , J) +ZMU( I , JPl ) ) 

ZMUM=0 . 5* ( ZMU( I , J ) +ZMU( I , JMl ) ) 

YYP  =0.5*(Y(I, J)+Y(I, JPl) ) 

YYM  =0.5*(Y(I, J)+Y(I, JMl) ) 

YJP  =RJ(I, JP1)/Y(I, JPl) 

IF( JMl.EQ. 1)THEN 
YJM=0 . 

ELSE 

YJM  =RJ(I, JM1)/Y(I, JMl) 

END  IF 

I F ( PRNT . EQ . 0 . DO ) THEN 

GAMP=0 . 5* (GAMMA( I , JPl ) +GAMMA( I , J) ) 

GAMM=0 , 5* (GAMMA( I , JMl ) +GAMMA( I , J) ) 

GKCPP=ZMUP*GAMP/PRN 

GKCPM=ZMUM*GAMM/PRN 

ELSE 

ZMUTP  =  0.5*(ZMUT(JP1)+ZMUT(J)) 

ZMUTM  =  0.5*(ZM‘v  T(  JM1)+ZMUT(J)  ) 

ZMULP  =  ZMUP  -  LMUTP 
ZMULM  =  ZMUM  -  ZMUTM 
GAMP=0 . 5* (GAMMA( I , JPl ) +GAMMA( I , J) ) 

GAMM=0.5*(GAMMA(I, JM1)+GAMMA(I, J) ) 

GKCPP  =  GAMP*(ZMULP/PRN+ZMUTP/PRNT) 

GKCPM  =  uAMM* (ZMulM/PRN+ZMUTM/PRNT) 

ENDIF 

EXJ=ETAX( I , J)/RJ( I , J) 

EY J=ETAY ( I , J ) /R J ( I , J ) 

ZMUU=ZMU( I , J) 

0R=1./RH0{I, J) 

0RP=1./RH0(I, JPl) 

0RM=1./RH0(I, JMl) 

ZMURP=ZMU( I , JPl ) *ORP 
ZMURM=ZMU( I , JMl ) *0RM 
UR  =U(I,J)*OR 
URP=U( I , JP1)*0RP 
URM=U( I , JMl )*ORM 
VR  =V(I,J)*OR 
VRM=V(I, JM1)*0RM 
VRP=V{ I , JP1)*0RP 
UMRP=URP*ZMU( I , JPl ) 

UMRM=URM*ZMU( I , JMl ) 

VMRP=VRP*ZMU( I , JPl ) 

VMPM=VRM*ZMU( I , JMl ) 

U2R  =TIR*U(I,J) 
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U2RP=URP*U( I, JPl) 

U2RM=URM*U( I , JMl ) 

V2R  =VR*V( I , J) 

V2RP=VRP*V( I , JPl) 

V2RM=VRM*V(I, JMl) 

UVR  =UR*V( I , J) 

UVRP=URP*V(I, JPl) 

UVRM=URM*V( I , JMl) 

ER2  =E( I , J)*OR**2 

ER2P=E( I , JPl )*ORP**2 

ER2M=E { I , JMl ) *ORM**2 

ZRYJP=ZMURP*YJP 

ZRYJM=ZMURM*YJM 

ORYJP=ORP*YJP 

ORYJM=ORM*YJM 

VMRP^-ZMURP*V( I , JPl ) *YJP 

VMRM=-ZMURM*V( I , JM1)*YJM 

URYJP=-URP*YJP 

URYJM=-URM*YJM 

VYJP^2 . *2MU{ I , JPl ) *VRP*YJP 

VYJM=2 . *ZMU( I , JMl ) *VRM*YJM 

V2YJP=-V2RP*2 . *ZMU( I , JPl ) *YJP 

V2YJM=-V2RM*2 . *ZMU( I , JMl )*YJM 

UVYJP=-2 . *ZMU( I , JP1)*UVRP*YJP 

UVYJM=-2 . *ZMU( I , JM1)*UVRM*YJM 

V Y  J  P  2  = VY J  P  *  0 . 5 

VYJM2=0. 5*VYJM 

UYJP=ZMU( I , JPl ) *URP*YJP 

UYJM=ZMU ( I , JMl ) *URM* YJM 

AAP1=  ZMUP*A1(I, J)*YYP 

AAP2=  ZMUP*A2( I, J)*YYP 

AAP3=  ZMUP*A3( I, J)*YYP 

AAP4=  GKCPP*A4( I , J)*YYP 

AAM1=  ZMUM'^A1(I,  JM1)*YYM 

AAM2=  ZMUM*A2(I, JM1)*YYM 

AAM3  =ZMUM*A3(I, JM1)*YYM 

AAM4  =GKCPM*A4 ( I , JMl ) * YYM 

IF(  JMl  .EO.  1  .'THEN 

CALL  SZER0(4,A) 

ELSE 

A(l,l)  -0. 

A ( 1 , 2  )  =0 . 

Ml, 3)  -0. 

A( 1 , 4)  =0. 

A21^(AAM1*URM+AAM2*VRM)*RJ( I, JM1)/Y( I, JMl ) 

A  (2,1)  -^A21-l  ./3  .  *EXJ*VMRM 

A( 2 , 2 )  --AAM1*0RM*RJ( I , JMl )/Y( I , JMl ) 

A( 2 , 3 )  =-AAM2*0RM*RJ( I , JMl )/Y( I , JMl ) -1 . /3 . *EXJ*ZRYJM 
A (2, 4)  ^0. 

A3  1  =  ( AAM2  *URM+AAM3  * VRM ) *RJ ( I , JMl )/Y( I , JMl ) 

A(3,l)  =A31+1./3.*ZMU(I,J) 

*  *EXJ*URYJM 

A( 3 , 2 )  =-AAM2*0RM*RJ( I , JMl )/Y( I , JMl ) +1 . /3 . *ZMU( I , J ) *EXJ*ORYJM 
A  (  3 , 3  )  =:-AAM3 *ORM*R  J  (  I ,  JMl  )/Y{  I ,  JMl ) 

A(3,4)  =0. 
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A{ 4, 1 )  -AAM4* ( -ER2M+U2RM+V2RM)+AAM1*U2RM+AAM3*V2RM+ 

+  2 . *AAM2*UVRM) *RJ ( I , JMl )/Y( I , JMl ) - 

+  1 . /3 . *EYJ*V2YJM- 1./3 . *EXJ*UVYJM 

A( 4, 2 )  =AAM4*URM*RJ( I , JMl )/Y( I , JMl ) -A2 1- 1 . /3 • *EXJ*VYJM2 
A( 4 , 3 )  -AAM4’ VRM*RJ( I , JMl )/Y( I , JMl ) -A31-1 . /3 . *EYJ*VYJM- 

*  1 . /3 . *EXJ*UYJM 

A ( 4 , 4 )  AAM4*ORM*R J ( I , JMl ) /Y ( I , JMl ) 

END  IF 
C(l,l)  =0. 

C(l,2)  =0. 

C(l,3)  =0. 

C(l,4)  ^0. 

C21=(AAP1*URP+AAP2*VRP)*RJ( I, JP1)/Y( I, JPl) 

C(2,l)  -C21+1 . /3 . *EXJ*VMRP 

C(2 , 2  )  =-AAPl*ORP*RJ( I , JPl )/Y( I , JPl ) 

2 . 3  )  =-AAP2*0RP*RJ( I , JPl )/Y( I , JPl ) +1 . /3 • *EXJ*2RYJP 
C(2,4)  =0. 

C31=( AAP2*URP+AAP3*VRP ) *RJ( I , JPl )/Y( I , JPl ) 

C(3,l)  =C31-1./3.*ZMU(I, J) 

*  *EXJ*URYJP 

C{3,2)  =-AAP2*ORP*RJ( I , JPl )/Y( I , JPl ) - 1 . /3 - *ZMU( I , J ) *EXJ*ORYJP 
C(3, 3  )  =-AAP3*ORP*RJ( I , JP1)/Y( I, JPl) 

C(3,4)  =0. 

C ( 4, 1 )  = ( - AAP4* ( -ER2P+U2RP+V2RP ) +AAP1*U2RP+AAP3*V2RP+ 

+  2 . * AAP2*UVRP ) *RJ( I , JPl )/Y( I , JPl ) + 

+  1 . /3 . *EYJ*V2YJP+1 . /3 . *EXJ*UVYJP 

C { 4 , 2 )  =AAP4*URP*RJ ( I , JPl )/Y( I , JPl ) -C2 1+ 1 . /3 . *EXJ*VYJP2 
C( 4, 3 )  =AAP4*VRP*RJ( I , JPl )/Y( I , JPl ) -C31+1 . /3 • *EYJ*VYJP+ 

+  1 . /3 . *EXJ*UYJP 

C(4, 4)  =-AAP4*ORP*RJ( I , JP1)/Y(I, JPl) 

AAl  =AAP1+AAM1 
AA2  =AAP2+AAM2 
AA3  =AAP3+AAM3 
AA4  =AAP4+AAM4 
B(l,l)  =0. 

B(l,2)  =0. 

B(l,3)  =0. 

B(l,4)  =0. 

B(2, 1)  =(-AAl*UR-AA2*VR)*RJ( I, J)/Y(I, J) 

B(2,2)  =AA1*0R*RJ( I, J)/Y( I, J) 

B(2,3)  =AA2*OR*RJ(I, J)/Y(I, J) 

B(2,4)  =0. 

B(3, 1)  =(-AA2*UR-AA3*VR)*RJ( I, J)/Y(I, J) 

B(3,2)  =AA2*0R*RJ( I , J)/Y( I , J) 

B(3,3)  =AA3*OR*RJ(I, J)/Y(I, J) 

B(3,4)  =0. 

B(4, 1 )  ^(AA4*(-ER2+U2R+V2R)-AA1*U2R-AA3*V2R- 

*  2.*AA2*UVR)*RJ(I, J)/Y(I, J) 

B(4, 2)  =-AA4*UR*RJ( I, J)/Y( I , J)-B(2, 1) 

B(4, 3 )  =-AA4*VR*RJ( I , J ) /Y{ I , J ) -B( 3 , 1 ) 

B(4,4)  =AA4*OR*RJ(I, J)/Y( I, J) 

RETURN 

END 

C - 

SUBROUTINE  EIGMTX 
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C* 

C*  SUBROUTINE  FOR  EIGENVECTOR  MATRIX  CALCULATION 
C*  IF  lA^l  L  FOR  ACAP 
C*  IF  IA-2  L  FOR  BCAP 
C* 

(2'k  ir  it  -k  -k  ir  'k  it  ir  -k  -k  if  ic  -k  ^  ic  -k  -k  'k  -k  ir  -k  -k  'k  -k  "k  -k  -k  -k  ic  -k  'k  -k  ic  ie  -k  -k  "k  -k  "k  "k  "k  "k  "k  "k  "k  "k  "k  ic  "k  -k  "k  ie  ie  ie  "k  ie  "k  ic 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( IZ=150 , JZ=80 ) 

COMMON/VECTOR/DQ( IZ, JZ, 4) ,Q( IZ, JZ,4) , F( IZ , JZ, 4 ) , G( IZ, JZ , 4 ) , 

>  P( IZ, JZ) ,U( IZ, JZ) ,V( IZ, JZ) ,UN( IZ, JZ) , VN( IZ, JZ) 
COMMON/COORD/SA IX(IZ,JZ),SAIY(IZ,JZ), ETAX ( I Z , JZ ) , ETAY ( I Z , JZ ) 

>  ,ZMUT( JZ) ,RJ( IZ, JZ) ,X( IZ, JZ),Y(IZ, JZ),DELTAU(IZ, JZ) 

>  , AREA( IZ) , ZMU( IZ, JZ) , A1 ( IZ, JZ) , A2( IZ, JZ) , A3( IZ, JZ) , A4( IZ, JZ) 
COMMON/CONST/A I N , AEX , RL , EX I , EYI , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 

'CFLl , PRNT, PB, RMl, SUM(4) , ZMUO , REN, PRN, TWALL , TREF 
>,BI0T,TW1 

COMMON/CONST 1/GAMMA ( I Z , JZ ) , GMl ( IZ, JZ ) , CP ( IZ , JZ ) , CV( IZ, JZ) ,RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV, ITIME, IVISC,NORD, IWALL 

>  , IWBC, IFLOW 

DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ),RHOV( IZ , JZ ) , E ( IZ , JZ ) 
EQUIVALENCE(Q( 1, 1, 1 ) ,RH0(1, 1) ) , (Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(1,1,3),RH0V(1,1)), (Q(1,1,4),E(1,1)) 

Q******************************************************************* 

DIMENSION  A(4,4) 

ir  -k  it  'k  ir  ^  ic  -k  -k  ir  'k  •f'  -k  -k  -k  "k  -k  it  -k  -k  •k  -k  "k  -k  ie  -k  ie  "k  -k  "k  'k  •!(  ic  ic  ir  ie  ic  "k  ic  *  -k  -k  -k  ic  -k  •k  -k  'k  "k  -k  'k  "k  "k  •k  -k  •k  if  •k  "k  "k 

ENTRY  EIGEN( lA, A, I , J) 

IF( lA.EQ. 2 )G0  TO  10 
CX=SAIX( I, J) 

CY=SAIY( I , J) 

GO  TO  20 
10  CX=ETAX( I , J) 

CY=ETAY( I , J) 

20  CONTINUE 

SQ2=DSQRT(2 .DO) 

C=DSQRT ( GAMMA (I,J)*P(I,J) /RHO (I , J ) ) 

C 1=CX/DSQRT ( CX*  *  2  +CY*  *  2 ) 

C2=CY/DSQRT(CX**2+Cy**2 ) 

A{1,  1)=1.-0.5*GM1(I, J)*(U(I, J)**2+V(I, J)**2)/C**2 
A(1,2)=GM1(I, J)*U(I, J)/C**2 
A(1,3)=GM1( I, J)*V(I, J)/C**2 
A(1,4)=-GM1(I, J)/C**2 

A(2, 1)=(-C2*U(I, J)+C1*V( I, J))/RHO(I, J) 

A(2,2)=C2/RHO(I, J) 

A(2,3)=^-C1/RH0(  I,  J) 

A(2, 4)=0. 

A(3,  1)=-(C1*U( I , J)+C2*V( I , J) )/SQ2/RH0( I, J)  + 

>  0. 5/SQ2*GMl( I, J)*(U(I, J)**2+V( I, J)**2)/RH0( I, J)/C 
A  (  3 , 2  )  =^C  1  /SQ2/RH0  (I,J)-GM1(I,J)  /SQ2  *U  ( I ,  J  )  /RHO  ( I ,  J )  /C 
A(3 , 3 )=C2/SQ2/RH0( I , J ) -GMl ( I , J )/SQ2*V( I , J)/RHO( I , J)/C 
A{3,4)=GM1( I , J)/SQ2/RH0( I , J)/C 

A(4, 1)=(C1*U(I, J)+C2*V(I, J) )/SQ2/RH0(I, J)+0.5/SQ2*GMl(I, J)* 

>  (U( I, J)**2+V(I, J)**2)/RH0(I, J)/C 

A(4, 2)=-Cl/SQ2/RHO( I , J ) -GMl ( I , J )/SQ2*U( I , J)/RHO( I , J)/C 
A (4, 3 )=-C2/SQ2/RHO( I , J ) -GMl ( I , J )/SQ2*V( I , J)/RHO( I , J)/C 
A ( 4 , 4 ) =GM1 ( I , J ) /SQ2/RH0 ( I , J ) /C 
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RETURN 

C* 

C*  LEFT  &  RIGHT  EIGENMATRIX  FOR  XI  DIRECTION 
C* 

ENTRY  EIG^Ri' A,  I  ,  J) 

CX-SAIX( 1,0) 

CY=SATY( I , J) 

SQ2=1 ./DSQRT(2 .DO) 

C=DSQRT ( GAMMA (I,J)*P(I,J) /RHO ( I , J ) ) 

CXCY=1 ./DSQRT(CX**2+CY**2 ) 

C1=CX*CXCY 
C2=CY*CXCY 
A(l, 1)=1. 

A(l,2)=0. 

A(l,3)=RH0(I,  T)*SQ2/C 
A(1,4)=A(1,3) 

A(2,1)=U(I, J) 

A(2,2)=RHO(I, J)*C2 

A(2 , 3  )=SQ2*RHO(  I ,  J)  *  (U(  I  ,  .J)/C  +  C1 ) 

A(2,4)=SQ2*RHO( I, J)*(U( I, J)/C-C1) 

A(3,1)=V(I, J) 

A(3,2)=-RHO( I, J)*C1 

A(3, 3 )=SQ2*RHO( I , J)* (V( I , J)/C+C2) 

A ( 3 , 4 ) =SQ2  *RHO (I,J)*(V(I,J) /C-C2 ) 

A(4, 1)=0.5*(U(I, J)**2+V(I, J)**2) 

A(4,2)=RHO( I, J)*(U( I, J)*C2-V(I, J)*C1) 

TEMP=0. 5*SQ2*RHO(  I  ,  J  )  MU(  I ,  J)  **2+V(  I ,  J  )  **2  )/C 
+  +RHO(I,  J)*SQ2'^C/GM1(I,  J) 

RUC=SQ2*RHO( I, J)*(U( I , J ) *C1+V( I , J) *C2 ) 

A (4,  3  )=TEMP-*-RUC 
A(4, 4)=TEMP-RUC 
RETURN 
END 


SUBROUTINE  COEFY( I ) 

C* 

C*  SETTING  COEFFICIENTS  FOR  LY-OPERATOR 
C* 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  (  I  Z=150 ,  JZ-^80  ) 

COMMON, /VECTOR/DQ( IZ,JZ,4),Q(IZ,JZ,4),F(IZ,JZ,4),G(IZ,JZ,4), 

>  P( IZ, JZ) ,U( IZ, JZ) , V( IZ, JZ) ,UN( IZ, JZ) , VN( IZ, JZ) 
COMMON/COORD/S A IX(IZ,JZ),SAIY(IZ,JZ), ETAX ( I Z , JZ ) , ETAY ( I Z , JZ ) 

>  , ZMUT( JZ) , RJ( IZ, JZ) ,X( IZ, JZ) , Y( IZ, JZ) , DELTAU( IZ, JZ) 

>  , AREA( IZ) ,ZMU( IZ, JZ) , Al( IZ, JZ) , A2( IZ, JZ) , A3( IZ, JZ) , A4( IZ, JZ) 
COMMON/CONST/AIN, AEX, RL, EXI , EYI , OMEGAX, OMEGAY, CFL, THETA, PO , TO , 

>CFL1 , PRNT , PB , RMl , SUM ( 4 ) , ZMUO , REN, PRN, TWALL , TREF 
> , BIOT, TWl 

COMMON/CONSTl /GAMMA ( IZ, JZ) , GMl ( IZ , JZ ) , CP ( I Z , JZ ) ,CV( IZ, JZ) , RGAS 
COMMON/INTEG/IL, JL,  I  LI , JLl , NEND, NBEG, NADV, ITIME, IVT5C,NORO, IWALL 

>  ,IWBC,IFLOW 

DIMENSION  RHO( IZ, JZ) , RHOU ( I Z , JZ ) , RHOV( I Z , JZ ) , E ( I Z , JZ ) 
EQUIVALENCE(Q( 1, 1,1), RHO( 1,1)), ( Q{ 1 , i , 2 ) , RHOU ( 1 , 1 ) ) , 
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(Q(l, l,3),RHOV(l,l)), (Q(1,1,4),E(1,1)) 


■  -k  -k  -k  -k  -k  -x 


DIMENSION  AM(4, 4, JZ) ,BM(4,4, JZ) ,CM(4,4, JZ) ,DM(4, JZ) 
DIMENSION  DTEMP(4) , ISUB( JZ) 

DIMENSION  B(4,4) ,BL1(4,4) ,D(4,4),A(4, 4) ,AJM(4,4) 
CHOI  BEG IN 

DIMENSION  AMIL1(4, 4) , BMI LI ( 4, 4 j , CMI LI ( 4, 4 ) , DMILl ( 4 ) 
DIMENi>ION  BJ2(4,4)  ,BJ1(4,4)  ,DD(4,4) 

DIMENSION  AMIL(4,4) ,BMIL(4,4) ,CMIL(4,4) ,DMIL(4) 
DIMENSION  AMINV(4,4) 

DIMENSION  AB1(4, 4) , AB2(4, 4) , AB3(4,4) , AB4(4, 4) 
DIMENSION  D1 (4) , D2 (4) ,D3 (4) ,D4(4) 

CHOI END 

DATA  ISUB/J2*0/ 

r^k-k'k-k-k-k'k'fkk'kk'k-kkk'k'k'kk'k'k'fr'k'k-k-k-k'k-k-k'k'k'k'kicir'kir'k'k'k'k'k'k'k'k'k'k'k-k’k'k'k'k’k' 

C*  CHECK  THE  SONIC  POINT  AT  DOWNSTREAM  END 
IF( IVISC.NE. l)GOTO  15 
IF( I .NE. IL)GOTO  15 
DO  5  J=:1,JL 

C0=DSQRT ( GAMMA {I,J)*P(I,J) /RHO ( I , J ) ) 

CONTRA=UN( I , J)-DSQRT(SAIX( I , J)**2+SAIY( I , J)**2 )*C0 
I F ( CONTRA . LT . 0 . DO ) THEN 
I  SUB ( J )  =  1 
ELSE 

ISUB( J)^0 
END  IF 

I F  (  UN  (  I  ,  -J )  .  LT  .  0  .  DO  )  I  SUB  (  J  )  =2 
IF(FB.EQ.0.D0)ISUB(J)=0 
I F ( NADV . EQ . 1 ) r  SUB ( J ) =0 
5  CONTINUE 
15  CONTINUE 
C* 

C*  ON  THE  CENTEF  iU.NE  OF  THE  NOZZLE  AT  J=1 


k  "k  "k  k  k  k 


CALL  SZERO( 4, AM( 1 , 1 , J) ) 
CALL,  SZER0(4,BM(1,  1,  J)  ) 
DO  2  0  M=-- 1 , 4 
DM ( M , J ) =C . 

BM(M,M, J)=BM(M,M, J)+l .0 
20  CONTINUE 

CAM,  SZERO(  4,CM(  1  ,  1,  J)  ) 


C*  INTERIOR  HODS 

C* 

DO  80  .J  =  2,Jr,l 

TAUD=0 . 5D0^DELTAU( I , J) *THETA/EYi 
TAUD2=2 . *TAUD 
JMl-J-1 
JPl-  T  +  1 


CALL  ,JAC0B(2,B,  I,.TM1) 

CALL  3MM(4, -TAUD, B, AM( I , 1 , J) ) 
CALL  SZEPO ( 4 , BM ( 1 ,  1 , J  )  ) 

DO  60  M- I , 4 

60  BM(M,  M,  .T)=BM(M,M,  J  )  +  1  . 
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I F ( I . FQ . I L -  AND . I  SUB ( J ) . NE . 0 ) THEN 
^ALL  AJACOB(l,A, I, J) 

CALL  SZERO(4,AJM) 

ELSE 

CALL  TRUEJ( 1, A, I , J) 

CALL  TRUEJ(2,AJM, I, J) 

END  IF 

CALL  DHDQ(D, I, J) 

DO  65  M=l,4 
DO  65  N=l,4 

BM(M,N, J)=BM(M,N, J)-TAUD2*(D(M,N)-A(M,N)+AJM(M,N) ) 

IF( I .NE. 2 . AND. I . LT . I  LI ) BM ( M , N, J ) =BM( M, N, J ) +N0RD*TAUD* 
*  (A(M,N)-AJM(M,N) ) 

65  CONTINUE 

CALL  JAC0B(2,B, I, JPl) 

CALL  SMM(4,TAUD,B,CM(1, 1, J) ) 

C* 

C*  INSERT  VISCOUS  JACOBIAN  LHS  HERE 
C* 

IF( IVISC. EQ. 1 )THEN 
CALL  VJAC0B(A, B,D, I , J) 

DO  68  M=l,4 
DO  68  N=l,4 

AM(M,N, J)=AM(M,N, J)+DELTAU(I, J)*A(M,N) 

BM(M,N, J)=BM(M,N, J)+DELTAU(I, J)*B(M,N) 

68  CM(M,N, J)=CM(M,N, J) ^DELTAU( I, J)*D(M,N) 

ELSE 
END  IF 
DO  70  K=l,4 
70  DM(K,  J)=^DQ(  I,  J,K) 

SUBSONIC  REGION  KEEP  BACK  PRESSURE 

IF(IVISC.EQ.l. AND . ( I . EQ . I L . AND . I SUB ( J ) . EQ . 1 ) ) THEN 
CALL  EIGEN(1,BL1, I, J) 

DO  72  K=l,4 
72  BL1(4,K)=0. 

CALL  MMM(4,BL1, AM( 1, 1, J) , A) 

CALL  MMM(4,BL1,BM(1,1, J),B) 

CALL  MMM(4,BL1,CM(1, 1, J) ,D) 

DO  74  M=l,4 
DO  74  N=l,4 
AM{M,N, J)=A(M,N) 

BM(M,N,  J)-^B(M,N) 

74  CM(M,N, J)=D(M,N) 

DO  76  M=l,4 
DTEMP(M)=0. 

DO  76  K=l,4 

DTEMP(M)=DTEMP(M) +BL1 (M, K)*DM(K, J) 

76  CONTINUE 

DO  78  M=1 , 4 
78  DM(M, J)=DTEMP(M) 

BM(4, 1, J)=0.5*GM1( I, J)*(U( I, J)**2+V( I, J)**2)/Y( I, J) 
RM(4,2, J)=-GM1( I, J)*U( I, J)/y(I, J) 

BM(4, 5,  J)^-GM1(  I  ,.I)*V(  I  ,  J)/Y(  I  ,  J) 
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BM(4,4, J)=GM1(I, J)/Y(I, J) 

1F(PB.NE.0.D0)THEN 
DM(4,.7)  =  (PB-P(  I,  J)  )/RJ(  I,  J) 

ELSE 

DM(4, J)=0. 

END  IF 
ELSE 
END  IF 
C 

C  REVERSE  FLOW  REGION 
C 

IF ( I Vise. EQ. 1 .AND. ( I -EQ. I L . AND . I SUB( J ) . EQ . 2 ) )THEN 
CALL  EIGEN(1,BL1, I, J) 

DO  73  K=l,4 
BL1(1,K)=0. 

BL1(2,K)=0. 

73  BL1(4,K)=0. 

CALL  MMM(4,BL1,AM(1, 1, J) ,A) 

CALL  MMM(4,BL1,BM(1, 1, J) ,B) 

CALL  MMM(4,BL1,CM(1, 1, J) ,D) 

DO  75  M=l,4 
DO  75  N=l,4 
AM(M,N, J)=A(M,N) 

BM(M,N, J)=B(M,N) 

75  CM(M,N, J)=D(M,N) 

DO  77  M=l,4 
DTEMP(M)=0. 

DO  77  K=l,4 

DTEMP ( M ) =DTEMP ( M ) +BL1 (M,K)*DM(K,J) 

77  CONTINUE 

DO  79  M=l,4 
79  DM(M, J)=DTEMP(M) 

RJYY=RJ( I , J)/Y( I , J) 

RCV=RHO( I , J)*CV( I, J) 

RJRCV=RJYY/RCV 

BM(1,1,J)={-E(I,J) /RHO (I,J)+GM1(I,J) /GAMMA (I,J)*(U(I,J)**2 

>  +V(I, J)**2))*RJRCV 

BM( 1,2, J)=-GM1( I, J)/GAMMA(I, J)*U(I, J)*RJRCV 
BM  (  1 , 3  ,  J )  =-GMl  (  I ,  J  )/GAMMA  (  I ,  J  )  •*V{  I ,  J )  *RJRCV 
BM(1,4, J)=RJRCV 

Cl-(RHO( I , J)*E( I , J)-0. 5*RHO( I, J)**2*(U( I, J)**2+V(I , J)**2 ) ) 
C2=(RHO(I, J)*E( I, J)-0. 5*GM1( I, J)/GAMMA( I, J)*RHO( I, J)**2* (U( I, J)**2 

>  +V(I,J)**2)) 

C3=^(C2/C1)**(GAMMA(  I  ,  J  ) /GMl  (  I ,  J )  ) 

C4=GAMMA( I , J ) /GMl { I , J ) /Cl* ( C2/C1 )**(!. DO/GMl ( I , J ) ) 

BM(2, 1, J)=(0.5*(U(I, J)**2+V(I, J)**2)*C3+C4*E(I, J)*(C1-C2)/RH0(I, J) 

>  )*GM1( I , J)*RJYY 

BM(2,2, J)=(-U( I, J)*C3+C4*U(I, J)*(C2-GM1(I, J)/GAMMA(I, J)*C1) ) 

>  *GM1( I , J)*RJYY 

BM(2, 3, J)=(-V( I , J)*C3+C4*V( I, J)*(C2-GM1(I, J)/GAMMA(I, J)*C1) ) 

>  *GM1( I, J)*RJYY 

BM(2, 4, J)=(C3+C4*(C1-C2) )*GM1(I, J)*RJYY 
BM(4, 1, J)^-VN(I, J)*RJYY/RHO(I,J) 

BM( 4, 2, J)=ETAX( I , J ) *RJYY/RHO( I , J) 

BM ( 4 , 3 , J ) =ETAY ( I , J ) *R JYY/RHO ( I , J ) 


84 


FILE:  PNSVIS 


FOR 


A1  VM/SP  CMS  4-8602  (02/02/88) 


THE  PENNSYLVANIA  STAI 


BM(4, 4, J)=0. 

T0N=(E( T, J)/RHO(I, J)-0.5*GM1(I, J)/GAMMA(I, J)*(U(I, J)**2 
>  +V(I, J)**2) )/CV(I, J) 

TT  =(E( I , J)/RHO( I , J)-0. 5* (U( I , J)**2+V( I , J)**2 ) )/CV( I , J) 
P0N=P( I, J)*(TON/TT)**(GAMMA(I, J)/GK1(I, J) ) 

DM(1,J)=  (TWALL-TON) 

DM(2,J)=  (PB-PON) 

DM(4,J)=  -VN(I,J) 

END  IF 
C 

CHOI 

CHOI 

IF( IVISC.EQ.O.AND. J.EQ. JLl)  GOTO  8001 
GO  TO  80 

8001  DO  8002  M=l,4 
DO  8002  N=l,4 
AMIL1(M,N)=AM(M,N, JLl ) 

8002  CONTINUE 

DO  8003  M=l,4 
DO  8003  N=l,4 
BMIL1(M,N)=BM(M,N, JLl) 

8003  CONTINUE 

DO  8004  M=1 , 4 
DO  8004  N=l,4 
CMIL1(M,N) -CM(M,N, JLl) 

8004  CONTINUE 

DO  8005  M=l, 4 
DMIL1(M)=DM(M, JLl) 

8005  CONTINUE 
CHOI 

CHOI 

80  CONTINUE 


c* 

C*  WALL 

BOUNDARY  CONDITION 

C* 

CHOI 

J=JL 

CHOI 

TAUD=THETA*DELTAU( I , J)/EYI 

CHOI 

IF( IVISC.EQ. l)GOTO  111 

CHOI 

CALL  SZERO(4,AM(l, 1, J) ) 

CHOI 

CALL  JACOB ( 2, B, I, J-1) 

CHOI 

CALL  A JACOB (1, A, I, J) 

CHOI 

CALL  AJAC0B(2,AJM, I, J) 

CHOI 

CALL  EIGEN(2,BL1, I, J) 

CHOI 

DO  90  M=l,3 

CHOI 

DO  90  N=l,4 

CHOI 

DO  90  K=l,4 

CHOI 

90 

AM(M,N, J)=AM(M,N, J)-TAUD*BL1(M,K)*B(K,N) 

CHOI 

CALL  SZER0(4,BM(1, 1, J) ) 

CHOI 

CALL  JACOB(2,B, I, J) 

CHOI 

CALL  DHDQ(D, I , J) 

CHOI 

DO  100  M=l,3 

CHOI 

DO  100  N=l,4 

CHOI 

EM(M,,  N,  J)=BM(M,N,  J)+BL1(M,N) 

CHOI 

DO  100  K=l,4 

CHOI 

BM(M,N, J)=BM(M,N, J)+TAUD*BL1(M,K)*{B(K,N'+A(K,N)-D(K,N)-AJM(K,N) ) 
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CHOI  IF(I.NE.2.AND.I.LT.IL1)  BM(M, N, J )=BM( M, N, J ) +NORD*0 . 5*TAUD* 

CHOI  *  BL1(M,K)*(A(K,N)-AJM(K,N) ) 

CHOI  100  CONTINUE 

CHOI 

CHOI BEG 

J^-JL 

TAUD=THETA*DELTAU( I , J)/EYI 
IF( IVISC.EQ. 1)  GOTO  111 
CALL  JACOB(2,BJ2, I, J-2) 

CALL  JAC0B(2,BJ1, I, J-1) 

CALL  JACOB(2,B, I, J) 

CALL  AJACOB(l, A, I, J) 

CALL  AJACOB(2,AJM, I, J) 

CALL  EIGEN(2,BL1, I, J) 

DO  899  N=l,4 
899  BL1(4,N)=0.D0 
CALL  HJAC(DD,J) 

DO  90  M=l,4 
DO  90  N=l,4 

AMIL(M,N)=0. 5D0*BJ2(M,N)*TAirD 

90  CONTINUE 

DO  91  M=l,4 
DO  91  N=l,4 

BMIL(M,N)=-2 .D0*BJ1(M,N)*TAUD 

91  CONTINUE 

CALL  JAC0B(2,B, I, J) 

CALL  DHDQ(D,I,J) 

DO  100  M=l,4 
DO  100  N=l,4 

CMIL(M,N)=DD(M,N)+TAUD*( 1 . 5D0*B(M, N) +A(M, N) -D( M, N ) -AJM(M, N) ) 

IF( I .NE.2 . AND. I .LT. ILl)  CMIL(M,N)=CMIL(M, N) +N0RD*0 . 5D0*TAUD* 

>  (A(M,N)-AJM(M,N) ) 

100  CONTINUE 

DO  1001  M=l,4 
1001  DMIL(M)=DQ( I , JL,M) 

C  DO  2001  M=l,4 

CC  WRITE(6,2002)  I , ( AMILl (M, N ) , N=1 , 4) 

C2001  CONTINUE 

C2002  F0RMAT(2X, I5,2X,4D14.5) 

CALL  INVER(4, AMILl, AMINV) 

CALL  MMM(4, AMINV,BMIL1, ABl) 

CALL  MMM(4, AMIL, ABl, AB2 ) 

DO  101  M=l,4 
DO  101  N=l,4 

101  AB3 (M,N)=AB2(M,N)-BMIL(M,N) 

CALL  MMM(4,BL1, AB3, AB4) 

DO  102  M=l,4 
DO  102  N=^l,4 

102  AM(M,N, J)=AB4(M,N) 

CALL  MMM(4, AMINV,CMIL1,AB1) 

CALL  MMM(4, AMIL, ABl, AB2 ) 

DO  103  M=l,4 
DO  103  N=l,4 

103  AB3(M,N)=AB2(M,N)-CMIL(M,N) 

CALL  MMM(4,BL1,AB3,AB4) 
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DO  104  M=l,4 
DO  104  N=^l ,  4 

104  J)=AB4(M,N) 

CALL  MMV(4, AMINV,DMIL1,D1) 

CALL  MMV(4, AMIL,D1,D2) 

DO  105  M=l,4 

105  D3(M)=D2(M)-DMIL(M) 

CALL  MMV(4,BL1,D3,D4) 

DO  106  M=l,4 

106  DM(M, J)=D4(M) 

CHOI 

CHOI END 

BM(4, 1, J)=-VN( I , J) 

BM(4,2, J)=ETAX(I, J) 

BM(4,3, J)=ETAY(I, J) 

BM(4, 4, J)=0. 

CALL  SZER0^4,CM( 1, 1, J) ) 

CHOI  DO  110  M=l,3 

CHOI  DM(M,J)=0. 

CHOI  DO  110  K=l,4 

CHOI  DM(M, J)=DM(M, J)+BL1(M,K)*DQ(I, J,K) 

CHOI  110  CONTINUE 
C  WRITE(6,*)  I, J,BM(4, 1, J) 

DM(4, J)=0. 

GOTO  119 

111  CONTINUE 

CALL  SZER0(4,AM(1, 1, J) ) 

CALL  SZERO(4,CM( 1, 1, J) ) 

CALL  S2ERO(4,BM(l,l, J) ) 

DO  112  M=l,4 
DM(M, J)=0. 

112  BM(M,M, J)=1.0 

IF( IWBC.EQ. 1)THEN 
OR=l ./RHO( I, J) 

ORCV=OR/CV(I, J) 

U2V2=U( I, J)**2+V( I, J)**2 
U2V21=U(I, JL1)**2+V(I, JL1)**2 
Y J JL=R J { I , JL ) /Y ( I , JL ) 

YJJL1=RJ( I , JL1)/Y( I , JLl) 

BM(1, 1, J)=(-E( I, J)*OR+U2V2)*YJJL*ORCV 
BM( 1,2, J)=-U( I, J)*YJJL*ORCV 
BM ( 1 , 3 , J ) =- V ( I , J ) * YJ JL*ORCV 
BM ( 1 , 4 , J ) =YJ JL*ORCV 
BM(2, 1, J)=0. 

BM(2, 2, J)=YJJL 
BW(2,3, J)=0. 

BM(2,4, J)=0. 

BM(3, 1, J)=0. 

BM(3,3, J)=YJJL 
BM(3,4, J)^0. 

C1=SAIX(I, J)*ETAX(I, J)+SAIY(I, J)*ETAY(I, J) 

C2--ETAX(  I  ,  J)**2+ETAY(  I ,  J)**2 

CB^C1+C2 

IF( I .GT.2)  CB=CB+0. 5*FL0AT(N0RD)*C1 
CD^C1*P( I-l , J) 
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I F( I . GT . 2 )  CD=CD+N0RD*C1* ( P ( I- 1 , J ) -0 . 5*P ( I -2 , J ) ) 
BM (  4 ,  1 ,  J  )  ==0 . 5*U2 V2 * YJ JL*GM1  ( I ,  J )  *CB 
BM(4,2, J)=-U(I, J)*YJJL*GM1(I, J)*CB 
BM(4, 3 , J)=-V( I , J)*YJJL*GM1( I , J ) *CB 
BM(4, 4, J)=YJJL*GM1( I , J)*CB 
AM(4, 1, J)=-0. 5*U2V21*YJJL1*GM1( I, J)*C2 
AM(4, 2 , J)=U( I , J-1 )*YJJL1*GM1( I , J)*C2 
AM(4,3, J)=V(I, J-1)*YJJL1*GM1(I, J)*C2 
AM(4,4, J)=-YJJL1*GM1( I, J)*C2 
DO  113  M=l,3 
113  DM(M,J)=0. 

TJJ=P ( I , J ) /RHO ( I , J ) /RGAS 
DM( 1, J)=TWALL-TJJ 

DM(4, J)=CD+C2*P( I , JL1)-CB*P( I, JL) 

ADIABATIC  WALL 

IF( IWALL.EQ.O)THEN 
ORCV= 1 . /RHO ( I . J ) /CV ( I , J ) 

0RCV1=1 ./RHO( I , J-1)/CV( I , J-1) 

RUU=RGAS 

TIM1=P( I-l, J)/RHO( I-l, J)/RUU 
CD=C1*TIM1 
I F ( I . GT . 2 )  THEN 
TIM2=P( 1-2, J)/RHO( 1-2, J)/RUU 
CD=CD+NORD*Cl*(TIMl-0. 5*TIM2) 

ENDIF 

BM( 1, 1, J)=(-E( I , J)*OR+U2V2)*YJJL*ORCV*CB 
BM(1,2, J)=-U( I, J)*YJJL*ORCV*CB 
BM( 1 , 3 , J ) =-V ( I , J ) *YJJL*ORCV*CB 
BM ( 1 , 4 , J ) =Y J JL*ORCV*CB 

AM( 1 , 1 , J )=- ( -E( I , J-1 ) *OR+U2V21 ) *YJJL1*0RCV1*C2 

AM ( 1 , 2 , J ) =U ( I , J- 1 ) * Y J JLl *0RCV1*C2 

AM( 1 , 3 , J )=V( I , J-1 ) *YJJL1*0RCV1*C2 

AM( 1 , 4, J)=-YJJL1*0RCV1*C2 

T JM1=P ( I , J- 1 ) /RHO ( I , J- 1 ) /RUU 

T J  J=P ( I , J ) /RHO ( I , J ) /RUU 

DM( 1, J)=CD+C2*TJM1-CB*TJJ 

ENDIF 

WALL  COOLING  (FROM  UPSTREAM  TO  DOWNSTREAM 

I F ( I WALL . EQ . 2 . AND . I  FLOW . EQ . 1 )THEN 
C1=C1/RJ( I , J) 

C2^C2/RJ( I , J) 

C3=BIOT/Y( I, J) 

CB=C1+C2+C3 

IF( I .GT.2)  CB=CB+0. 5*FLOAT(NORD)*(Cl+C3) 

ORCV=l ./RHO( I , J)/CV( I , J) 

0RCV1=1 . /RHO ( I , J- 1 ) /CV ( I , J- 1 ) 

RUU=RGAS 

TIM1=P(I-1, J)/RHO(I-l, J)/RUU 
CD^(C1+C3 )*TIM1 
I F ( I . GT . 2 )  THEN 
TIM2=P( 1-2, J)/RHO( 1-2, J) /RUU 
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CD=CD+NORD* (C1+C3 ) * (TIMl-0 . 5*TIM2 ) 

END  IF 

BM( 1 , 1, J)=(-E( I , J)*ORfU2V2)*YJJL*ORCV*CB 
BM( 1 , 2 , J)=-U( I , J)*YJJL*ORCV*CB 
BM( 1, 3, J)=-V( I , J)*YJJL*ORCV*CB 
BM ( 1 , 4 , J ) =Y J JL*ORCV*CB 

AM( 1, 1, J)=-(-E( I , J-1)*0R+U2V21)*YJJL1*0RCV1*C2 
AM( 1 , 2 , J )^U( I , J- 1 ) *YJ JL1*0RCV1*C2 
AM( 1 , 3 , J )=V( I , J-1 ) *YJJL1*0RCV1*C2 
AM( 1, 4, J)=-YJJL1*0RCV1 *C2 
TJM1=P(I, J-1)/RH0(I, J-1)/RUU 
T J J=P ( I , J ) /RHO ( I , J ) /RUU 
DM( 1 , J)=CD+C2*TJM1-CB*TJJ 
END  IF 

INVERSE  COOLING  FLOW 

IF( I WALL. EQ. 2 .AND. I  FLOW . EQ . - 1 )THEN 
IF( I .EQ. IL)THEN 
Diyi(l,J)=  TWl-TJJ 
GOTO  119 
END  IF 

C1=C1/RJ( I, J) 

C2=C2/RJ( I , J) 

C3=-BI0T/Y( I , J) 

CB=C2- (C1+C3 ) 

IF( I .LT. ILl)  CB=CB-0.5*FLOAT(NORD)*(C1+C3) 
0RCV=1./RH0{I, J)/CV(I, J) 

0RCV1=1./RH0(I, J-1)/CV(I, J-1) 

RUU=RGAS 

TIM1=P( I+l, J)/RHO( I+l, J)/RUU 
CD=-{C1+C3)*TIM1 
IF(I.LT.ILl)  THEN 
TIM2=P( 1+2, J)/RHO( 1+2, J)/RUU 
CD=CD+NORD* ( C1+C3 ) * ( -TIMl+0 . 5*TIM2 ) 

END  IF 

BM( 1 , 1 , J ) = ( -E ( I , J ) *OR+U2V2 ) *YJJL*ORCV*CB 
BM(1,2, J)=-U( I, J)*YJJL*ORCV*CB 
BM( 1 , 3 , J)=-V( I , J) *YJJL*ORCV*CB 
BM( 1 , 4, J)=YJJL*ORCV*CB 

AM(1, 1, J)=-(-E( I, J-1)*0R+U2V21)*YJJL1*0RCV1*C2 
AM ( 1 , 2 , J ) =U ( I , J- 1 ) * YJ JL1*0RCV1 *C2 
AM( 1 , 3 , J)=V( I , J-1 )*YJJL1*0RCV1*C2 
AM( 1 , 4, J)=-YJJL1*0RCV1*C2 
T JM1=P ( I , J- 1 ) /RHO ( I , J- 1 ) /RUU 
TJJ=P( I , J)/RHO( I , J)/RUU 
DM( 1, J)=CD+C2*TJM1-CB*TJJ 
END  IF 
C 

END  IF 

119  CONTINUE 
C* 

C*  SOLVE  4*4  BLOCK  TRIDIAGONAL  MATRICS 
C* 

CALL  NBTRIP(AM,BM,CM,DM, 1, JL,4) 
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DO  120  J=1,JL 
DO  120  K=l,4 
DQ( I , J, K)=DM(K, J) 

120  CONTINUE 
RETURN 
END 

C - - - 

SUBROUTINE  FLUXCL 
C* 

C*  SUBROUTINE  FOR  FLUX  VECTOR  CALCULATION 
C* 

Q*******:V****'****************************************************** 

IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( I Z=150 , JZ=80 ) 

COMMON/ VECTOR/DQ( IZ,JZ,4),Q(IZ,JZ,4),F(IZ,JZ,4),G(IZ,JZ,4), 

>  P( IZ, JZ) ,U( IZ, JZ) , V( IZ, JZ) ,UN( IZ, JZ) , VN( IZ, JZ) 
COMMON/COORD/SA IX(IZ,JZ),SAIY(IZ,JZ), ETAX ( I Z , J2 ) , ETAY (I Z , JZ ) 

>  ,ZMUT( JZ),RJ( IZ, JZ) ,X(IZ, JZ),Y(IZ, JZ) ,DELTAU(IZ, JZ) 

>  , AREA( IZ) , ZMU( IZ, JZ) , Al( IZ, JZ) ,A2( IZ, JZ) ,A3( 12, JZ) , A4( IZ, JZ) 
COMMON/CONST/AIN, AEX, RL, EXI , EYI , OMEGAX, OMEGAY, CFL, THETA, PO, TO, 

>CFL 1 , PRNT , PB , RMl , SUM ( 4 ) , ZMUO , REN , PRN, TWALL , TREF 
>,BI0T,TW1 

COMMON/CONST 1/GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , CP ( I Z , JZ ) , CV ( I Z , JZ ) , RGAS 
COMMON/INTEG/IL, JL, ILl , JLl , NEND, NBEG, NADV, ITIME, IVISC,NORD, IWALL 

>  ,IWBC,IFLOW 

DIMENSION  RH0( IZ, JZ) ,RHOU( IZ, JZ) ,RHOV( I Z , JZ ) , E ( IZ , JZ ) 
EQUIVALENCE(Q(1,1,1),RH0(1,1)),(Q(1,1,2),RH0U{1,1)), 

(Q(l, 1,3), RHOV( 1,1)), (Q( 1,1,4), E(l,l)) 

0************-<r*************************  +  **************************** 

DIMENSION  A(4,4) 

ENTRY  FLUX(II) 

I^I  I 
C* 

C*  COMPUTE  CONVECTIVE  TERMS 
C* 

DO  10  J^-1,JL 

F( I, J, l)=RH^:i, J)*UN(I, J)/RJ(I, J)*Y(I, J) 

F( I, J,2)=(  .OU(I, J)*UN(I, J)+SAIX(I, J)*P(I, J) )/RJ(I, J)*Y{I, J) 

F(  I  ,  J,  3  )=:(RHOV(  I  ,  J)*UN(  I ,  J)+SAIY(  I,  J)*P(  I,  J)  )/RJ  (  I ,  J  )  *Y  ( I  ,  J  ) 

F( I, J,4)=(E(I, J)+P(I, J) )*UN(I, J)/RJ(I, J)*Y(I, J) 

CALL  A JACOB (1, A, I, J) 

DO  3  K=l,4 
F(I, J,K)=0. 

DO  3  JJ=1,4 

3  F( I , J,K)=F(I, J,K) ♦A(K, JJ)*Q(I, J, JJ)*Y(I, J)/RJ(I, J) 

G( I, J, l)=RHO(I, J)*VN(T, J)/RJ(I, J)*Y(I, J) 

G ( I , J , 2 ) = ( RHOU ( I , J ) * VN ( I , J ) +ETAX( I,J)*P(I,J)) /RJ ( I , J ) * Y ( I , J ) 
G(I,J,3)  =  (RHOV(I,J)*VN(I,J) +  ETA Y (I,J)*P(I,J))/RJ(I,J)*Y(I,J) 

G(I, J,4)-(E(I, J)+P(I, J) )*VN(I, J)/RJ(I, J)*Y(I, J) 

10  CONTINUE 
RETURN 
C* 

C*  E  MINUS  FLUX  VECTOR 
C* 

ENTRY  FLUXM(II) 
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I  =  I  I 

DO  20  J=1,JL 

CALL  A JACOB (2, A, I , J) 

DO  17  K=l,4 
G ( I , J , K ) =0 . 

DO  17  JJ=1,4 

17  G( I, J,K)=G(I, J,K)^A(K, JJ)*Q(I, J, JJ)/RJ(I, J)*Y(I, J) 
20  CONTINUE 
RETURN 
C* 

C*  VISCOUS  FLUX  VECTOR 
C* 

ENTRY  VFLUX(II) 

I  =  II 

DO  30  J=2,JL1 
JP1=J+1 

ZMUP=0. 5* (ZMU( I , J)+ZMU( I , JPl ) ) 

ZMUM=0. 5* (ZMU( I , J)+ZMU( I , JMl ) ) 

I F ( PRNT . EQ . 0 . DO ) THEN 

GAMP=0 . 5* (GAMMA( I , JPl ) +GAMMA( I , J) ) 

GAMM^O . 5  * ( GAMMA ( I , JMl ) +GAMMA ( I , J ) ) 

GKCPP-ZMUP*GAMP/PRN 

GKCPM=ZMUM*GAMM/PRN 

ELSE 

ZMUTP  =  0. 5*(ZMUT( JP1)+ZMUT( J) ) 

ZMUTM  =  0.5*(ZMUT(JM1)+ZMUT(J)) 

ZMULP  =  ZMUP  -  ZMUTP 

ZMULM  =  ZMUM  -  ZMUTM 

GAMP=0 . 5* (GAMMA( I , JPl ) +GAMMA( I , J) ) 

GAMM=0.5*(GAMMA(I, JM1)+GAMMA(I, J) ) 

GKCPP  =  GAMP*(ZMULP/PRN+ZMUTP/PRNT) 

GKCPM  =  GAMM*(ZMULM/PRN+ZMUTM/PRNT) 

END  IF 

YYP-0.5*(Y(I, J)+Y(I, JPl) ) 

YYM=0.5*(Y( I, J)+Y(I, JMl) ) 

YZP=YYP*ZMUP 
YZM=YYM*ZMUM 
AAP1=A1(I, J)*YZP 
AAM1=A1(I, JM1)*YZM 
AAP2=A2(I, J)*YZP 
AAM2=A2(I, JM1)*YZM 
AAP3=a3( I , J)*YZP 
AAM3=A3(I, JM1)*YZM 
AAP4=A4( I , J)*YYP*GKCPP 
AAM4'=A4  (  I ,  JMl )  *YYM*GKCPM 
UP=U(I, JP1)-U(I, J) 

UM=-U(I, JM1)+U(I, J) 

VP=V(I, JP1)-V(I, J) 

VM=V(I, J)-V(I, JMl) 

ERP=E(I, JP1)/RH0(I, JP1)-E(I, J)/RHO(I, J) 

ERM^E{ I , J)/RH0( I , J)-E( I , JMl )/RHO( I , JMl ) 

U2P=U( I , JPl )**2-U( I , J)**2 
U2M-U{ I, J)**2-U(I, JM1)**2 
V2P^V( I,JP1)**2-V(I,J)**2 
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I , J) -*2-V( I , JMl )**2 
UVP:^U(  I  ,  JPl  )  *V(  I  ,  JPl  )-U(  I  ,  J)*V(  I  ,  J) 
i’VM-n(  I ,  J) -y(  I ,  .1) -u(  I ,  JMi  )*v(  I ,  JMl ) 

G  (  1  ,  J  „  1  )  0  . 

G(  I  .  J,  2  )^(  AAF1*UP-AAM1*UM)  *•  ( AAP2 *VF- AAM2 * VM ) 

G( I , J, 3 )-(AAP2*UP-AAM2*UM)+{AAP3*VP-AAM3*VM) 

G(  I  ,J ,  4)  =  (  AAP4*ERP-AAM4*ERM)  +0. 5-*  (  (AAP1-AAP4)*U2P- 

(  AAM1-AAM4)  *U2M)  +0 . 5*  (  ( AAP3- AAP4 )  ■*- V2P-  (  AAM3 - AAM4 )  * V2M )  + 
( AAP2*UVP-AAM2*UVM) 

C* 

C*  INSERT  THE  EXTRA  FIRST  ORDER  TERMS  IN  CYLINDRICAL  COORDINATE 
C*  SYSTEMS 


C* 

E Y J=ETAY ( I , J ) /R J ( I , J ) 

EX J  =ETAX ( I , J ) /RJ ( I , J ) 

DMUV=0. 5- (ZMU( I , JPl ) *V( I , JPl )-ZMU( I , JMl ) *V( I , JMl ) ) 

DDV  =0.  (V(  I ,  JPl  )-V(  I  ,  JMl  )  ) 

DMtlV2=0. 5*  (ZMU(  I  ,  JPl  )-^V(  I  ,  JPl )  * *2 - ZMU (  I  .  JMl  )*V(  I  ,  JMl  )**2  ) 
DM' iny=0 . 5 *  (  ZMU  (  I  ,  JP 1  )  *U (  I  ,  JP 1 )  *V (  I  ,  JP 1  )  - 
*  ZMU( I , JMl ) *U( I , JMl )*V( I , 'Ml ) ) 

DDU  -0 . 5* (U( I , JPl ) -U( I , JMl ) ) 

DDMU- 0 . 5  * ( ZMU ( I , JF 1 ) - ZMU ( I , JMl )  ) 

G(  I  ,  J,  2  )=G(  I  ,  J,  2  )-2  ./3  .  *EXJ*DML'V 

G( I , J, 3 )=G( I , J, 3 ) +2 . /3 . * (ZMU( I , J ) *EXJ*DDU- V ( I , J )*EYJ*DDMU) 
G  (  I  ,  J  ,  4  )  '^G  (  I  ,  J ,  4  )  -2  .  /G3  .  *  (  EYJ*DMUV2  -*  EXJ*DMUin/ ) 

30  CONTINUE 
RETURN 
ND 

C - - - - - - - - 

C  **  RIGHT  HAND  SIDE  CALCULATION 

C - - - - 


SUBROUTINE  RHSCL 


r  -p  *  - 


C* 


IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( IZ=150, JZ=80  ) 

COMMON/VECTOR/DQ ( I Z , JZ . 4 ) , Q ( I Z , JZ , 4 ) , F ( I Z , JZ , 4 ) , G ( I Z , JZ , 4 ) , 

P(  IZ,  JZ)  ,U( IZ, JZ) , V( IZ. JZ) ,UN( IZ, JZ) , VN( IZ, JZ) 
Cl'MMOr/  COORD/SAIX(  IZ,  JZ)  ,  SAIY(  IZ,  JZ)  ,  ETAX(  IZ,  JZ)  ,  ETAY(  IZ,  JZ) 

, ZMUT ( JZ ) , R J ( I Z , JZ ) , X ( I Z , JZ ) , Y ( I Z , JZ ) , DELTAU ( I Z , JZ ) 

'  , AREA( IZ) ,ZMU( IZ, JZ) ,A1( IZ, JZ) ,A2( IZ, JZ) , A3( IZ, JZ) ,A4( IZ, JZ) 
COMMON/CONST/A I N , AEX , RL , EX I , EYI , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 
'■CFLI  ,  PRNT,  PB,  RMl ,  SUM(  4)  ,  ZMUO,  REN,  PRN,  TWALL,TREF 
' ,  BIOT, TWl 

COMMON/CONST 1 /GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , CP ( I Z , JZ ) , CV ( IZ, JZ) ,RGAS 
COMMON/INTEG/IL, JL, I  LI , JLl , NEND, NBEG , NADV , ITIME, IVISC,NORD, IWALL 
,IWBC,IFLOW 

DIMENSION  RHO( IZ, JZ) , RHOU( IZ, JZ) ,RHOV( I Z , JZ ) , E ( I Z , JZ ) 
E9UN^ALENCE(Q(1,  1,^)  ,RH0(1.  1)  )  ,  ( Q (  1 ,  1 , 2  )  ,  RHOU ( 1 ,  1 )  )  , 

(Q(l, 1,3) ,RH0V(1, 1) ), (Q( 1,1,4) ,E(1, 1) ) 


ENTRY  RHS (IT) 
I-I  I 


CALL  FLUX( I-l ) 

C  rF(  (  I  .NE.  2  .  AND.  T  .NE.  11,1  )  .AND.NORD.EO.  1)CALL  FLUX  (1-2) 

CAr,L  FLUX(I) 
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EXI 1=2 . *EXI 
L/I I=EYI*2 . 

DO  10  J=1,JL 
DO  10  K=l,4 
10  DQ(I,J,K)=0. 

J=TL 
JMl-J-1 
IM1=I-1 
DO  20  K=l,4 

DQ( I , J, K)=DQ( I, J,K)+F( I , J , K ) -F( I - 1 , J , K ) + 

CHOI  *  G(I, J,K)-G( I, JM1,K) 

CHOI 

"  (3.D0-G( I, J,K)-4.D0*G(I, J-1,K)+G(I, J-2,K) )*0.5D0 

CHOI 

20  CONTINUE 

DO  100  J=2,JL1 
JP1=J+1 
JM1=J-1 
DO  100  K=l,4 
IF( I .NE. 1)THEN 

DQ( I, J,K)=DQ(I, J,K)+F(I, J,K)-F(I-1, J,K)+ 

>  (G(I, JP1,K)-G(I, JM1,K))*0.5 

ELSE 

DQ(I, J,K)=DQ(I, J,K)+0.5*(G(I, JP1,K)-G(I, JM1,K)) 

END  IF 

100  CONTINUE 

IF(  I  .  EO.  ID  GOTO  120 
I F ( I . NE . 2 . AND . I . NE . I  LI ) THEN 
DO  110  J=1,JL 
DO  110  K=l,4 

DQ(I, J,K)=DQ(I, J,K)+NORD*0.5*(F(I, J,K)-2.*F(I-1, J,K)+ 

*  F{I-2,J,K)) 

110  CONTINUE 

END  IF 

120  CONTI  NT  IE 

IF( I .EQ. IL)GOTO  180 
IP1=I+1 

CALL  FLUXM(IPl) 

CALL  FLUXM(I) 

IF( ( I .NE. I  LI. AND. I .NE.2) . AND . NORD . EQ . 1)CALL  FLUXM( 1+2) 
DO  170  J=2,JL 
DO  170  K=l,4 

DQ( I , J,K)=DQ( I, J,K)+G( IPl, J,K)-G(I, J,K) 

IF( I .NE. I  LI .AND. I . NE . 2 )DQ ( I , J, K )=DQ{ I , J , K ) -NORD*0 . 5* 

*  (G(I+2, J/K)-2.*G(I+1, J,K)+G(I, J,K) ) 

170  CONTINUE 

180  CONTINUE 

DO  200  J=2,JL 

DQ(I,J,3)=DQ(I,J,3)-P(I,J)/RJ(I,J) 

200  CONTINUE 
RETURN 
C* 

C*  VISCOUS  RIGHT  HAND  SIDE 
C* 

ENTRY  VRHS(II) 


93 


o  n  n 


FILE:  PNSVIS 


FOR 


A1  VM/SP  CMS  4-8602  (02/02/88) 


THE  PENNSYLVANIA  STAI 


I^I  I 

CALL  VFLUX ( I ) 

DO  300  J=^2  ,  JLl 
DO  300  K=2 , 4 

300  DQ(I,J,K)=DQ(I, J,K)-G(I, J,K) 

DO  400  J^2,JL 

DQ( I , J , 3 )=Dg( I , J, 3 )+4./3 . *ZMU( I , J ) *V( I , J ) /( RJ ( I , J ) *Y( I , J) ) 
400  CONTINUE 
RETURN 
END 

C  SERVICE  SUBROUTINE 

Q  'kir-ki^'k'k-kicifir-k’k-kyz'k^ie-k'k-k-k'k'k'k-k'k-k'kic’k’kic-k-k'k'k'k'k'k'k'k'k'k'k'k'k'k'k-k'k'k'k'k'k-K'kic'k'k'k'k'k 


SUBROUTINE  SUPPLY 
IMPLICIT  REAL*8(A-H,0-Z) 

PARAMETER  ( I Z=150 , JZ=80 ) 

COMMON/VECTOR/DQ(  I Z ,  JZ  ,  4 )  ,  Q { IZ ,  JZ,  4 )  ,  F (  I Z ,  JZ ,  4 )  ,  C-(  I Z ,  JZ ,  4 )  , 

>  P( IZ, JZ) ,U(IZ, JZ),V(IZ, JZ) ,UN(IZ, JZ),VN(IZ, JZ) 
COMMON/COORD/SAIX( IZ, JZ ) , SAIY( IZ, JZ) , ETAX( IZ , JZ ) , ETAY( IZ , JZ ) 

>  , ZMUT( JZ) ,RJ( IZ, JZ) ,X( IZ, JZ) ,Y( IZ, JZ ) , DELTAU( IZ, JZ) 

>  , AREA( IZ) , ZMU( IZ, JZ) ,A1( IZ, JZ) ,A2( IZ, JZ) ,A3( IZ, JZ) ,A4(IZ, JZ) 
COMMON/CONST/A I N , AEX , RL , EX I , EYI , OMEGAX , OMEGAY , CFL , THETA , PO , TO , 

>CFL1 , PRNT, PB, RMl , SUM(4) , ZMUO, REN, PRN, TWALL, TREF 
>,BI0T,TW1 

COMMON/CONST 1 /GAMMA ( I Z , JZ ) , GMl ( I Z , JZ ) , CP ( I Z , JZ ) , C V ( I Z , JZ ) , RGAS 
COMMON, 'INTEG/IL, JL, I  LI , JLl , NEND, NBEG, NADV, ITIMS, IVISC,NORD, IWALL 

>  ,IWBC,IFLOW 

DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ) ,RHOV( IZ, JZ) , E( IZ, JZ) 
EpUIVALENCE(Q( 1, 1, 1) ,RH0(1, 1) ) , ( Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(1,1,3),RH0V(1,1)), (Q(1,1,4),E(1,1)) 

Qif  ir  it  -k  -k  -k  -k  if  -k  ir  ■*(  -k  ^  -k  -k  ^  ir  'k  "k  if  -k  it  if  "k  -k  if  'k  'k  'k  "k  it  ii  ie  ic  'k  ie  -k  ie  "k  "k  -k  "k  "k  -k  -k  "k  ic  -k  ic  'k  "k  it  ir  "k  'k  ic  ic  "k  ic  -k  •k  -k  'k 

DIMENSION  SS(4) 

DATA  GO, PATM/9 . 8067, 101325 ./ 

ENTRY  CHECK 
DO  10  K=l,4 
10  SS{K)=0. 

DO  20  1=2 , IL 
DO  20  J=2,JL 
DO  20  K=l,4 
QQ=Q(I, J,K) 

IF(QQ.EQ.O.DO)GO  TO  20 

SS(K)=SS(K)+(DQ(I, J,K)*RJ(I, J)/Y(I, J)/QQ)**2 
20  CONTINUE 

DO  30  K=l,4 

30  SS(K)=DSQRT(SS(K) )/( IL*JL) 

WRITE( 19, 500)NADV, ( SS ( K ) , K=1 , 4 ) 

500  FORMAT( I5,3X,4(1X,E14.7) ) 

RETURN 
ENTRY  MASS 


MASS  FLOW  RATE 

PPI=DARCOS(-1.DO) 
DO  80  1=1 , IL 
FLRT=0. 
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DO  75 

DELR=DSQRT( ( X( I , J+ 1 ) -X ( I , J ) ) **2+ ( Y( I , J+1 ) -Y( I , J ) ) **2 ) 
CXCV -DSQRT ( SAIX ( I , J ) *  *  2  +  SAI Y( I , J ) *  *2 ) 

CXC Y 1 -DSQRT  >  S A I X ( I , J ^ 1 ) *  *  2  +  SA I Y ( I , J  + 1 ) *  *  2 ) 

FLRT-FLRT  +  0 . 5 * PP I  * ( Y ( I , J+ 1 ) +Y ( I , J) )*DELR 
+  - (RHO( [ , J+l )*UN( I , J+1 )/CXCYl+RHO( I, J)*UN( I , J)/CXCY) 

75  CONTINUE 

WRITE( 18, 789)1 , FLRT 
80  CONTINUE 
789  FORMAT( IX, 18, E14. 7 ) 

THRUST  AND  T SP  CALCULATIONS 

I  - 1  L, 

THPUST-0 . 

DO  85 

DELR=DSQRT( ( X ( I , J+ 1 ) -X ( I , J ) ) * *2 + ( Y( I , J+ 1 ) - Y( I , J ) ) **2 ) 
THRlJST=THRUST+0 . 5*PPI*  ( Y(  I  ,  J  +  l )  +Y(  I ,  J)  )  *DELR* 

( RHO( I , J+l ) *U( I , J+l )**2+P( I , J+l )-PATM+ 

>  RKO(I,J)  *U(I, J)**2+P(I, J)-PATM) 

05  CONTINUE 

CCC-THRUST/FLRT 
SPI=CCC/GO 

WRITE( 18, 788)  THRUST, SPI 

788  FORMAT(  //,'***  THRUST= ' ,  E14 . 7 ,//,'** *  ISP  =',E14.7) 
RETURN 

ENTRY  OUTPUT 
WRITE( 18, 5^0)NADV 

550  FORMAT(//10( IH* )/'  NADV=',I5//) 

DO  50  I-1,IL 
DO  50  T-1,JL 

ST- ( E ( I , J ) /RHO (I,J)-GM1(I,J)*0. 5/GAMMA (I,J)*(U(I,J)**2+ 

-  V( I , J)**2 ) )/CV( I , J) 

TT=(E( I  ,  J)/RHO( I , J)-0. 5*(U( I , J)**2+V: I , J)**2) )/CV( I , J) 
RMA-DSQRT( ( U ( I , J ) *U( I , J ) +V ( I , J ) *V{ I , J ) )/GAMMA( I , J) 

^  ^RHO( I , J)/P( I , J) ) 

SP-P ( I , J ) * ( ST/TT ) *  * ( GAMMA { I , J ) /GMl ( I , J ) ) 

WRITE( 18, 607)X( I,J),Y(I,J),P(I,J), RMA,TT, V( I , J) 

WR I TE ( 66 )  ( Q ( I , J , K ) , K= 1 , 4 ) , DELTAU ( I , J ) 

507  FORMAT( 6{ IX, E14. 7 ) ) 

WRITE (6, 600) I , J,RHO( I , J ) , U( T , J j , V( I , J ) , E ( I , J ) , ST 
WRITE(6, 650)P( I , J) , UM ( I , J ) , VN( I , J ) , SP , TT 
600  FORMAT (IX,  , 12,  ' ,  '  , 1 2 , 3X, 5 ( IX, ElO . 3 ) ) 

650  FORMAT(10X,5(1X,E10.3)) 

50  CONTI  injE 

C 

C  WRITE  THE  LAST  TWO  LINES 
C 

C  DO  70  I-ILl , IL 

C  DO  70  J-1,JL 

C70  WRITE(68)  ( Q ( I ,  J , K ) , K- 1 , 4 ) 

C 
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RETURN 

END 
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0  ’k'k'k'k'k'k'k'k-k'k'k-k^-k'k'k'k’k-k'k'k'k-k'k'k'k'k’k'k'k'k'k'k’k'k'k'k-k'k'k-k’k'kie'k'ic'kir'k'k'k'k'k-k'k'k’k'k'k'kic'kie’k 

c* 

C*  LIBRARY  SUBROUTINES 
C* 

SUBROUTINE  NBTRIP ( A, B , C , D , ILO, lU, ORDER) 

IMPLICIT  REAL*8(A-H,0-Z) 

DIMENSION  A(1),B(1),C(1),D{1),IPS(5),X(5) 

INTEGER  ORDER, ORDSQ 
ORDSQ=ORDER**2 
I  =  ILO 

I 0MAT= 1 + ( I - 1 ) *ORDSQ 
I0VEC=l+( I-l)*ORDER 
CALL  LUDPVT(B( lOMAT) ,OPOER, IPS) 

CALL  LUSPVT ( B { I OMAT ) , D , I OVEC ) , D ( I OVEC ) , X , ORDER , I PS ) 

DO  100  J=l, ORDER 
I0MATJ=I0MAT+ ( J-1 )*ORDER 

CALL  LUSPVT ( B ( I OMAT ) , C ( I OMAT J ) , C ( I OMAT J ) , X , ORDER , I PS ) 

100  CONTINUE 
200  CONTINUE 
1  =  1  +  1 

IOMAT=l+( I-1)*0RDSQ 
I 0 VEC= 1 + ( I - 1 ) *ORDER 
I 1MAT= I OMAT-ORDSQ 
I1VEC=IOVEC-ORDER 

CALL  MULPUT(A( lOMAT ) , D ( I IVEC ) , D( lOVEC) , ORDER) 

DO  300  J=l, ORDER 
I OMAT J= I OMAT+ ( J- 1 ) *ORDER 
I IMAT J= I 1MAT+ ( J- 1 ) *ORDER 

CALL  MULPUT ( A ( I OMAT ) , C ( I IMAT J ) , B ( I OMAT J ) , ORDER ) 

300  CONTINUE 

IF( I .EQ. lU)  GO  TO  500 
CALL  LUDECO(B( lOMAT) , ORDER) 

CALL  LUSOLV(B( I OMAT) , D( lOVEC ), D( lOVEC ), ORDER ) 

DO  400  J=l, ORDER 
IOMATJ=IOMAT+( J-1)*0RDER 

CALL  LUSOLV { B ( I OMAT ) , C ( I OMAT J ) , C ( I OMAT J ) , ORDER ) 

400  CONTINUE 
GO  TO  200 
500  CONTINUE 

CALL  LUDPVT(B( lOMAT) , ORDER, IPS) 

CALL  LUSPVT(B( lOMAT) ,D( lOVEC) ,D( I OVEC ), X, ORDER, IPS) 

600  CONTINUE 
1  =  1-1 

IOMAT=l+( I-1)*0RDSQ 
IOVEC=l+( I-1)*0RDER 
I 1VEC=IOVEC+ORDER 

CALL  MULPUT(C( lOMAT) ,D( I IVEC) ,D(IOVEC) , ORDER) 

IF( I .GT. ILO)  GO  TO  600 

RETURN 

END 

C . - . - - - - - - - 

SUBROUTINE  LUDPVT( A, ORDER, IPS) 

IMPLICIT  REAL*8  (A-H,0-7) 

INTEGER  ORDER 

DIMENSION  A(ORDER, 1) , IPS f ORDER) 
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DO  5  1=1, ORDER 
IPS( I )=I 
5  CONTINUE 
NM1~ ORDER- 1 
DO  17  K=1,NM1 
BIG=O.ODO 
DO  11  I =K, ORDER 
IP=IFS( I ) 

SrZE=DABS(A( IP, K) ) 

IF( SIZE-BIG) 11, 11, 10 

10  BIG=SIZE 
IDXPIV=I 

11  CONTINUE 

IF( IDXPIV-K) 14, 15,14 

14  J=IPS(K) 

IPS(K)=IPS( IDXPIV) 

IPS( IDXPIV)=J 

15  KP=IPS(K) 

PIVOT=A(KP, K) 

KP1=K+1 

DO  16  I=KP1,0RDER 
IP=IPS( I ) 

EM=-A( IP,K)/PIV0T 

A( IP, K)=-EM 

DO  16  J=KP1, ORDER 

A( IP, J)=A(IP, J)+EM*A(KP, J) 

16  CONTINUE 

17  CONTINUE 
RETURN 
END 


SUBROUTINE  MULPUT( A, B, C, ORDER) 
IMPLICIT  REAL*8(A-H,0-Z) 
INTEGER  ORDER 
DIMENSION  A(l) ,B(1) ,C(1) 

DO  200  JR=1, ORDER 
SUM=0 . 0 

DO  100  JC=1, ORDER 
IA=JR+( JC-l)*ORDER 
100  SUM=SUM+A( IA)*B( JC) 

200  C( JR)=C( JR)-SUM 
RETURN 
END 


SUBROUTINE  LUSPVT( A, B, C, X, ORDER, IPS) 
IMPLICIT  REAL*8  (A-H,0-Z) 

INTEGER  ORDER 

DIMENSION  A(0RDER, 1) ,B{1) ,C(1) ,X(1) , IPS(l) 

NP1=0RDER+1 

IP=IPS(1) 

X(1)=B(IP) 

DO  2  I =2, ORDER 
IP=IPS( I ) 

IM1=I-1 
SUM=0 . ODO 
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DO  1  J=l, IMl 

1  SUM=SUM+A(IP, J)*X(J) 

2  X( I )=B( IP)-SUM 
I P^ I  PS (ORDER) 

C ( ORDER ) =X ( ORDER ) /A ( I P , ORDER ) 
DO  4  IBACK=2,ORDER 
I=NP1-IBACK 
IP=IPS( I ) 

IP1=I+1 

SUM=0 . ODO 

DO  3  J= I PI, ORDER 

3  SUM=SUM+A( IP, J) *C( J) 

4  C( I )=(X( I )-SUM)/A( IP, I ) 

RETURN 

END 

C - 

SUBROUTINE  LUDECO( A, ORDER) 
IMPLICIT  REAL*8(A-H,0-Z) 
INTEGER  ORDER 
DIMENSION  A(ORDER,l) 

DO  8  JC=2, ORDER 
8  A(l, JC)-A(1, JC)/A(1, 1) 

JRJC=1 

10  CONTINUE 

JRJC=JRJC+1 
JRJCM1=JRJC-1 
JRJCP1=JRJC+1 
DO  14  JR= JR JC, ORDER 
SUM=A( JR, JRJC) 

DO  12  JM=1,JRJCM1 
12  SUM=SUM-A( JR, JM)*A( JM, JRJC) 

14  A( JR, JRJC)=SUM 

I F( JRJC. EQ. ORDER)  RETURN 
DO  18  JC= JR JCPl, ORDER 
SUM=A( JRJC, JC) 

DO  16  JM=1,JRJCM1 
16  SUM=SUM-A( JRJC, JM)*A( JM, JC) 

18  A ( JRJC, JC)=SUM/A( JRJC, JRJC) 

GO  TO  10 
END 

C - 

SUBROUTINE  LUSOLV( A, B, C, ORDER) 
IMPLICIT  REAL*8(A-H,0-Z) 
INTEGER  ORDER 

DIMENSION  A(ORDER,l),B(l),C(l) 
C(1)=C(1)/A(1,1) 

DO  14  JR=2, ORDER 
.TRM1=JP-1 
SUM=B( JR) 

DO  12  JM=1,JRM1 
12  SUM=SUM-A( JR, JM)*C( JM) 

14  C( JR)^SUM/A( 7R, JR) 

DO  18  JR JR=2, ORDER 

JR=ORDER-JRJR+l 

JRP1=JR+1 
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SUM=C( JR) 

DO  16  JMJM=JRP1, ORDER 
JM^ORDER-JMJM+JRPl 

16  SUM=SUM-A( JR, JM)*C( JM) 

18  C(JR)=SUM 

RETURN 
END 

C - 

C  SET  ZERO  FOR  MATRIC  (M,iyi) 

SUBROUTINE  SZEROfM.A) 

IMPLICIT  REAL*8(A-H,6-Z) 

DIMENSION  A{M,M) 

DO  10  1=1, M 
DO  10  J=1,M 
A(I, J)=0.0D0 
10  CONTINUE 
RETURN 
END 

C - 

C  SCALAR*METRIC  (M,M) 

SUBROUTINE  SMM(M,C,A,B) 

IMPLICIT  REAL*8(A-H,0-Z) 

DIMENSION  A(M,M) ,B(M,M) 

DO  10  1=1, M 
DO  10  J=1,M 
B(I, J)=C*A(I, J) 

10  CONTINUE 
RETURN 
END 

C - - - 

C  METRIX*METRIX  (M*M) 

SUBROUTINE  MMM(M,A,B,C) 

IMPLICIT  REAL*8(A-H,0-Z) 

DIMENSION  A(M,M) ,B(M,M) ,C(M,M) 

DO  10  1=1, M 
DO  10  J=1,M 
C( I , J)=0.0D0 
DO  10  K=1,M 

C( I, J)=C(I, J)+A(I,K)*B(K, J) 

10  CONTINUE 
RETURN 
END 

0************************************************************* ****** 
SUBROUTINE  HJAC(A,J) 

C* ****************************************************************** 

IMPLICIT  REAL*8(A-H,0-Z) 

DIMENSION  A(4,4) 

CALL  SZERO(4,A) 

A( 1, 1)=1 .DO 

A(2,2)=1.D0 

A(3,3)=1.D0 

A(4, 4)=1 .DO 

RETURN 

END 

0************************** ********************************** 
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SUBROUTINE  MMV(M,A,B,C) 

IMPLICIT  REAL*8(A-H,0-Z) 

DIMENSION  A(M,M) ,B{M) ,C(M) 

DO  10  1=1, M 
C( I )=0.D0 
DO  10  K=1,M 
C(I)=C(I)+A(I,K)*B(K) 

10  CONTINUE 
RETURN 
END 

-k  it  -k  -k  -k  -k  'k  -k  -k  -k  ic  -k  -k  -k  -k  'k  -k  -k  -k  ic  'k  -k  -k  -k  "k  -k  -k  -k  ic  -k  it  -k  -k  "k  -k  ie  -k  "k  -k  -k  "k  -k  ie  -k  ie  -k  -k  -k  "k  -k  ic  "k  -k  -k  ic  ie  ic  ic  -k  ic  "k 

SUBROUTINE  INVER(M, A, AINV) 

IMPLICIT  REAL*8(A-H,0-Z) 

DIMENSION  A(4,4),B(4,4) , AINV(4, 4) , COF( 4, 4) 

A11=A(1, 1) 

A12=A( 1,2) 

A13=A(1,3) 

A14=A{ 1 ,4) 

A21=A(2, 1) 

A2  2=A (2,2) 

A23=A(2,3) 

A24=A(2, 4) 

A31=A(3, 1) 

A32=A(3, 2 ) 

A33=A(3,3) 

A34=A(3 , 4) 

A41=A(4, 1) 

A42=A{4,2) 

A43=A(4, 3  ) 

A44=A( 4, 4) 

DET=A11* ( A22*A33*A44+A23*A34*A42+A24*A43*A32-A24*A33*A42 

>  -A23*A32*A44-A22*A43*A34)- 

>  A12* (A21*A33*A44+A23*A34*A41+A24*A43*A31-A24*A33*A41 

>  -A23*A31*A44-A21*A43*A34)+ 

A13*(A21*A32*A44^A22*A34*A41+A24*A42*A31-A24*A32*A41 

>  -A22*A31*A44-A21*A42*A34)- 

>  A14* ( A21*A32*A43+A22*A33*A41+A23*A42*A31-A23*A32*A41 
-  -A22*A31*A43-A21*A42*A33) 

COF( 1 , 1 )=A22*A33*A44+A23*A34*A42+A24*A43*A32-A24*A33*A42 

>  -A23*A32*A44-A22*A43*A34 

COF( 1,2)=- (A21*A33*A44+A23*A34*A41+A24*A43*A31-A24*A33*A41 

>  -A23*A31*A44-A21*A43*A34) 

COF( 1, 3 )=A21*A32*A44+A22*A34*A41+A24*A42*A31-A24*A32*A41 

>  -A22*A31*A44-A21*A42*A34 

COF( 1,4)=-(A21*A32*A43+A22*A33*A41+A23*A42*A31-A23*A32*A41 

>  -A22*A31*A43-A21*A42*A33) 

COF(2, 1)=-(A12*A33*A44+A13*A34*A42+A14*A32*A43-A14*A33*A42 

>  -A13*A32*A44-A12*A43*A34) 

COF( 2 , 2 )=A11*A33*A44+A13*A34*A41+A14*A31*A43-A14*A33*A41 

>  -A13*A31*A44-A11*A43*A34 

COF(2,3)=-(All*A32*A44+A12*A34*A41+A14*A31*A42-A14*A32*A41 

>  -A12*A31*A44-A11*A42*A34) 

COF(2,4)=All*A32*A43+A12*A33*A41+A13*A31*A42-A13*A32*A41 

>  -A12*A31*A43-A11*A42*A33 

COF(3, 1 )=A12*A23*A44+A13*A24*A42+A14*A22*A43-A14*A23*A42 
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>  -A13*A22*A44-A12*A43*A24 

C('>F(  3 , 2  )=-  ( A11*A23*A44+A13*A24*A41+A14*A21*A43-A14*A23*A41 

>  -A13*A21*A44-A11*A43*A24) 

C0F(3, 3)=A11*A22*A44+A12*A24*A41+A14*A21*A42-A14*A22*A41 

>  -A12*A21*A44-A11*A42*A24 

C0F(3, 4)=-(All*A22*A43+A12*A23*A41+A13*A21*A42-A13*A22*A41 

>  -A12*A21*A43-A11*A42*A23 ) 

C0F(4, 1)=-{A12*A23*A34+A13*A24*A32+A14*A22*A33-A14*A23*A32 

>  -A13*A22*A34-A12*A33*A24) 

COF(4,2)=All*A23*A34+A13*A24*A31+A14*A21*A33-A14*A23*A31 

>  -A13*A21*A34-A11*A33*A24 

C0F(4, 3)=-(A11*A22*A34+A12*A24*A31+A14*A21*A32-A14*a22*A31 

>  -A12*A21*A34-A11*A32*A24) 

C0F(4, 4)=A11*A22*A33+A12*A23*A31+A13*A21*A32-A13*A22*A31 

>  -A12*A21*A33-A11*A32*A23 
AINV(1, 1)=C0F(1, 1)/DET 
AINV( 1, 2 )=C0F(2, 1)/DET 
AINV(1,3;=C0F(3, 1)/DET 
AINV(1, 4)=C0F(4, 1)/DET 
AINV(2, 1)-C0F(1,2)/DET 
AINV(2,2)=COF(2,2)/DET 
AINV(2,3)=COF(3,2)/DET 
AINV(2, 4)=C0F(4,2)/DET 
AIMV(3, 1)=C0F(1,3)/DET 
A I NV ( 3 , 2 ) =COF (2,3) /DET 
AI MV ( 3 , 3 ) =COF (3,3) /DET 
AINV(3 , 4)=C0F(4, 3 )/DET 
AINV(4, 1)=C0F(1,4)/DET 
AINV(4,2)=COF(2,4)/DET 
AINV(4, 3 )=C0F(3, 4)/DET 
AINV(4, 4)=C0F(4, 4)/DET 
CALL  MMM(4, A, AINV,B) 

DO  1  MM=1,4 

WRITE(6,10)  (B(MM,NN) ,NN=1,4) 

1  CONTINUE 
10  FORMAT(4D16.7) 

RETURN 
END 

(2"^  "ft  "k  "k  -k  -k  -k  "k  -k  it  -k  -k  "k  "k  -k  -k  -k  "k  "k  'k  it  it  'k  if  if  -k  "k  ic  i<  -k  ie  ie  'k  ie  ie  ie  ie  ie  "k  -k  -k  it  -k  "k  ic  ie  ic  ie  'k  it  •k  "k  'k  ie  ie  ^  -k  ie  it 

SUBROUTINE  CPGAM( CP , CV, GAMMA, GMl , R, I, J, 

>  RHO,RHOU,RHOV,E,TCP) 

0******************************************************************* 
PARAMETER( I Z=150 , JZ=100 ) 

IMPLICIT  REAL*8  (A-H,0-Z) 

COMMON/CPCOFF/  CPAl , CPA2 , CPA3 , CPA4 , CPAS , CPA6 , CPA7 

>  ,CPA8,CPA9,CPA10,ENE(101) 


IF(TCP.NE.O.O)  GOTO  20 

UU=RHOU/RHO 

W=RHOV/RHO 

EE=E/RH0-0. 5*(UU**2+VV**2 ) 
TT=300.0 

IF(EE.LE.ENE(1) )  GO  TO  20 
DO  10  MM=1, 101 
EA=  EE  -  ENE(MM) 
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EB=  EE  -  EME(MM+1) 

ESIGN=  EA*EB 
IF(ESIGN.LE.O.DO)THEN 

Tl=300.0+27 . 611*DFL0AT{MM-1) 

T2^300.0+27 . 611*DFL0AT(MM) 

TT=(T2*EA-T1*EB)/(EA-E3) 

GO  TO  20 
ELSE 
END  IF 

10  CONTINUE 

TT=3061 . IDO 
20  CONTINUE 

IF(TCP.NE.O.O)  TT=TCP 
C* 

IF(TT. LE. 1000.0) THEN 

CP=(CPA6+CPA7*TT+CPA8*TT**2+CPA9*TT**3+CPA10*TT**4) 

CV=CP-R 

ELSE 

CP=(CPA1+CPA2*TT+CP  ■v3*TT**2+CPA4*TT**3+CPA5*TT**4) 
CV=CP-R 
END  I F 
GAMMA=CP/CV 
GM1=GAMMA-1.0  > 

RETURN 

END 

0*********+***** 

SUBROUTINE  CPCOEF 
0*************** 

IMPLICIT  REAL*8  (A-H,0-Z) 

COMMON/CPCOFF/  CPAl , CPA2 , CPA3 , CPA4 , CPAS , CPA6 , CPA7 

>  ,CPA8,CPA9,CPA10,ENE(101) 

DIMENSION  Y( 10) , Al( 10) , A2( 10) ,A3(10) , A4(10) , A5(10) 

>  ,A6(10) ,A7(10) ,A8(10),A9(10),A10(10),WM(10) 
DATA  RU,WMMIX/8314.3,20.405/ 


CO 

WM( 1 )=28.010 
Y( 1 )=  0. 13108 

C  C02 

WM(2)=44.0 
Y(2)=  0.03636 

C  H 

WM(3)=1.0 
Y(3)=  0.02387 

C  H2 

WM(4)=2.0 
Y(4)=  0.15802 

C  H20 

WM(5)=i8. 0 
Y(5)=  0.32366 

C  NO 

WM(6)=30.0 
Y(6)=  0.00260 

C  N2 

WM(7)=28.0 
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Y(7)=  0.30407 

C  O 

WM(8)-16.0 
Y(8)-^  0.00158 

C  OH 

WM(9)=17.0 
Y(9)^  0.01744 

C  02 

WM( 10)=32 .0 
Y(10)=  0.00129 

C - CO 

Al(l)=  0.29840696E+01 
A2(l)=  0. 14891390E-02 
A3 ( 1 )=-0 . 57899684E-06 
A4( 1 )=  0. 10364577E-09 
A5(1)=-0.69353550E-14 
C 

A6(l)=  0. 37100g28E+01 
A7( l)=-0. 16190964E-02 
A8(l)=  0.36923594E-05 
A9( l)=-0.20319674E-08 
A10(l)=  0. 23953344E-12 

C - C02 

Al(2)=  0. 44608041E+01 
A2(2)=  0.30981719E-02 
A3(2)=-0. 12392571E-05 
A4(2)^  0.22741325E-09 
A5(2)=-0. 15525954E-13 
C 

A6(2)=  0.24007797E+01 
A7(2)=  0.87350957E-02 
A8(2 )=-0. 66070878E-05 
A9(2)=  0.20021861E-08 
A10(2)=  0.63274039E-15 

C - H 

Al(3)=  0.25000000E+01 
A2(3)=  0.00000000 
A3(3)=  0.00000000 
A4(3)=  0.00000000 
A5(3)=  0.00000000 
C 

A6(3)=  0.25000000E+01 
A7(3)=  0.00000000 
A8(3)=  0.00000000 
A9(3)=  0.00000000 
A10(3)=  0.00000000 

C - H2 

Al(4)=  0.30558123E+01 
A2(4)=  0. 59740400E-03 
A3(4)=-0. 16747471E-08 
A4(4)=-0.21247544E-10 
A5(4)=  0.25195487E-14 
C 

A6(4)=  0.29432327E+01 
A7(4)=  0.34815509E-02 
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A8(4)=-0. 77713819E-05 
A9(4)=  0. 74997496E-08 
A10(4)=-0. 25203379E-11 

C - - - H20 

Al(5)^  0. 26340654E+01 
A2(5)=  0. 31121899E-02 
A3 ( 5 ) =-0 . 90278449E-06 
A4(5)=  0. 12673054E-09 
A5(5)=-0. 69164732E-14 
C 

A6(5)=  0. 41675564E+01 
A7(5)=-0. 18106868E-02 
A8(5)=  0. 59450878E-05 
A9 ( 5 )=-0. 4867087 lE-08 
A10(5)=  0. 15284144E-11 

C-- - - NO 

Al(6)=  0.31486543E+01 
A2(6)=  0. 14151823E-02 
A3(6)=-0.57574881E-06 
A4(6)=  0. 1073S529E-09 
A5(6)=-0. 73900199E-14 
C 

A6(6)=  0. 42484931E+01 
A7(6)=-0.48661106E-02 
A8(6)=  0. 11634155E-04 
A9(6)=-0.99768494E-08 
A10(6)=  0. 30483948E-11 

C - - - - - N2 

Al(7)=  0. 28536374E+01 
A2(7)=  0. 16014368E-02 
A3( 7)=-0. 62888336E-06 
A4(7)=  0. 11428932E-09 
A5(7)=-0. 77953822E-14 
C 

A6{7)=  0. 37034288E+01 
A7(7)=-0. 14179405E-02 
A8(7)=:  0.28625094E-05 
Ag(7)=-0. 12018374E-08 
A10(7)=-0. 13475522E-13 

C - O 

Al(8)=  0. 25342961E+01 
A2(8)=-0. 12478170E-04 
A3(8)=-0. 12562724E-07 
A4(8)=  0.69029862E-11 
A5(8)=-0. 63797095E-15 
C 

A6(8)=  0. 30309401E+01 
A7(8)=-0.22525853E-02 
A8{8)=  0. 39824540E-05 
A9(8)=-0. 32604921E-08 
A10(8)=  0. iniS2n38F-l1 

C . . . OH 

Al(9)=  0.28897814E+01 
A2(9)=  0. 10005879E-02 
A3(9)=-0.22048807E-06 
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A4(9)=  0. 20191288E-10 
AS ( 9 )=-0. 3940983 lE-15 
C 

A6(9)  ^  0. 3e737300Et-01 
A7(9)=-0. 13393772E-02 
A8(9)=  0. 16348351E-05 
A9(9)--0. 52133639E-09 
A10(9)=  0. 41826974E-13 

C - 02 

Al(10)=  0. 36122139E+01 
A2(10)=  0. 74853166E-03 
A3 ( 10)=-0. 19820647E-06 
A4(10)=  0.33749008E-10 
A5( 10)=-0.23907374E-14 
C 

A6(10)=  0.37837135E+01 
A7( 10)=-0. 30233634E-02 
A8(10)=  0. 99492751E-05 
A9 ( 10) =-0. 98189 lOlE-08 
A10(10)=  0. 33031825E-11 


CPA1=0.D0 

CPA2=0.D0 

CPA3=0.D0 

CPA4=0.D0 

CPA5=0.D0 

CPA6=0.D0 

CPA7=0.D0 

CPA8=0.D0 

CPA9=0.D0 

CPA10=0.D0 

DO  10  J=l, 10 

CPA1=CPA1+Y( J)*A1 ( J)*RU/WMMIX 
CPA2=CPA2  +Y( J ) *A2 ( J ) *RU/WMMIX 
CPA3=CPA3 +Y ( J ) *A3 ( J ) *RU/WMMIX 
CPA4=CPA4+Y( J ) *A4 ( J ) *RU/WMMIX 
CPA5=CPA5+Y( J ) *A5 ( J ) *RU/WMMIX 
CPA6=CPA6+Y( J ) * A6 ( J ) *RU/WMMIX 
CPA7=CPA7  +Y ( J ) *A7 { J ) *RU/WMMIX 
CPA8=CPA8+Y( J ) * A8 ( J ) *RU/WMMIX 
CPA9=CPA9 + Y ( J ) *A9 ( J ) *RU/WMMIX 
CPA10=CPA10+Y( J ) *A10 ( J ) *RU/WMMIX 
10  CONTINUE 
C.  .  . 

R=^RU/WMMIX 
DO  20  MM=1,101 

TT=300. 0+27. 611*DFLOAT(MM-l) 

IF(TT  LE. 1000.0)THEN 

CP=(CPA6+CPA7*TT+CPA8*TT**2+CPA9*TT**3+CPA10*TT**4) 

CV=CP-R 

ENE(MM)=CV*TT 

ELSE 

CP=(CPA1+CPA2*TT+CPA3*TT**2+CPA4*TT**3+CPA5*TT**4) 

CV=CP-R 

ENE(MM)=CV*TT 
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END  IF 

20  CONTINUE 
RETURN 
END 

DATA. INPUT  DD  ' 

AINPUT  1 1  U. ,  ,Ti  ■  BO,  NPEG--1  ,  NEND^^l  ,NITER=1,  P0=1  D  +  06,  T0=3061.1D0, 
CFLl-()  .  SDt-04,  CFL^  100  .  ,  OMEGAX-^0  .  ,  OMEGAY^O  .  5  ,  RM1  =  1 . 2  ,  RM2=4 . 0 ,  NORP-^  1 , 
AIN-0 . 05 , AEX- . 236 , RL- . 695 , THETA=1 . 0, CP0=7152 . 4853 , GAMMA0=1 . 17 , 
I T  I  ME -- 1  ,  I  READ=  1 ,  FST=0 . 00  ,  TWALL=3000  .  ,  FSTY=0 . 9  ,  PB=0  .  ,  PRNT=0 . 7  , 

I V  I  SC^  1 ,  I  WALL=0  ,  PRN^-0 . 7  ,  REN=1 .  D5  ,  TREF=3000  .  ,  ZMUO-8 . 5D-03  , 
IWBO-l  BIOT=15 . , TWI=500. , IFLOW=l 

SEND 

'  DATA.  FT,"*3F001  DD  DSN^STU  .  I  I  9500  .  MYHIOO  .  HERMES  .  D I F  .  HI  3  5M80  .  V I S  , 
ri3P^(0LD,KEEP) ,VOL=REF=STU. I19500.MYH100.LIB, 
rCP- ( RECFM=VBS, LRECL^BO , BLKS IZE=3 120 ) , 

SPACE=(TRK, (9, 5) ,RLSE) 

0  DATA  .  F':’66F001  DD  DSN=STU.  I  19500  .  MYHIOO  .  HERMES2  .  DI F  .  RERUN  .  VI S  , 
DISF-^(NEW,  KEEP)  ,  VOL=REF=STU  .  1 19500  .  MYHIOO  .  LIB, 

DCB^I RECFM=VBS, LRECL-80 , BLKS I ZE=3 120 ) , 

SFACE= ( TRK , (9,5), RLSE ) 

DATA.  FTl'^'FOOl  DD  DSN-STU  .  I  .1  9500  .  MYHIOO  .  HERMES2  .  DI  F  .  DQ  .  VI  S  , 

DISr^(NEW, KEEP) ,VOL=REF=STU. 119500. MYHIOO. LIB, 

I.)CB^(RECFM=FB,  LRECL^SO  ,  BLKS I ZE=3  120  )  , 

/.  3F.5CE^(TRK,  (9,5),RLSE) 

/ ^DATA. rTlSFOOl  DD  DSN-STU.  I  1 9500 . MYHIOO . HERMES2 . DI F . SOLU . VI S , 
DISP-(NEW, KEEP) , VOL=REF=STU . 1 19500 . MYHIOO . LI B , 

DCB=(RECFM-FB, LRECL-130 , BLKS I ZE=3 120 ) , 

SPACE=(TRK,  (  9 , 5  )  ,  RLSE) 

// DATA . FT68F001  DD  DSN-STU . 1 1 9500 . MYHIOO . HERMES . CONV . LINE . VI S , 

//  D ISP- (OLD, KEEP ) , VOL -REF-STU . 1 19500 . MYHIOO . LIB, 

/,-'  DCB-f  RECFM-VBS,  LRECL-80,BLKSIZE=3120)  , 

//  SFACE-(TRK, ( 9 , 5 ) , RLSE) 

//  EXEC  PROMPTME 
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USERID: 

V19 

ORIGIN:  PSUVM 

CREATED : 

06/20/89 

15:48: 19 

FILENAME: 

NPROGll 

FOR 

CLASS:  A 

FORMAT : J 

SPOOLID: 

2822 

REGS:  3707 

COPY:  1 

DUPLICATE: 

1 

PRINTED  AT:  PSUVM  ID:  $PPCBP01  AT:  06/20/89  15:48:27 
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PROGRAM  NOZZLE ( INPUT , OUTPUT , TAPE5=INPUT , TAPE6=OUTPUT , 

>  TAPEl , TAPE2 , TAPE3 , TAPE4, TAPE? , TAPE8 , TAPE9 , TAPEIO , 

>  TAPE11,TAPE12) 

-k’kir’k-^-k'kh-k'k-k-k'k-k-^^'k'k-k'kic-^-k-tiy-^-kye^'ic-k-k-ki^-k-kicic-kie'k-kic-k-k-k-k'ie'k'k^-k’k'k-k-k'k-k-k-k-k'k'k-k 

*  PROGRAM  NAME:  NOZZLE  * 

*  AXI SYMMETRIC  SUPERSONIC  NOZZLE  FLOW  * 

*  IN  GENERAL  COORDINATE  SYSTEM  * 

*  USING  TIME  ITERATIVE  UW/CD  DDADI  METHOD  * 

*  WITH  THIN- LAYER  APPROXIMATED  NAV I ER- STOKES '  EQS .  * 

'kic'k'k'k'k'k'k'kiririt'k-k‘k-k'k'kiricici<ii:'k-^'k‘k'k'k‘k9:'k’k’k'k^‘k'k'k'k'k'k‘kie’ie'k-k'k'k'k'k'k'k'k'k'k'k'k‘k'k'k'k'k'k 

■k 

*  MAIN  PROGRAM 

•k 

kkkkkkkkkkkkkkkkkk'kk'k'kk-kk-k'k-k'k-k’k-k-k-k'kk'k'kk'k’k-kk’kk-kk’k'kk'k-kk-kk'k-kk'k-k'k-k'kk 


★ 

TAPEl 

-  READ 

NAMELIST  /INPUT/ 

★ 

TAPE2 

-  WRITE 

NAMELIST  /INPUT/ 

k 

TAPE3 

-  READ 

X(I,J),  Y(I,J) 

k 

TAPE4 

-  WRITE 

FLRT 

k 

TAPES 

-  READ 

INPUT  DATA 

k 

TAPE6 

-  WRITE 

OUTPUT  DATA 

k 

TAPE? 

-  READ 

DELTAU(I,J),  Q(I,J,K) 

*  TAPE8  -  WRITE  DELTAU(I,J),  Q(I,J,K) 

*  TAPE9  -  READ  NEND,  SS(K)  (=DQ/Q) 

*  TAPEIO  -  WRITE  NEND,  SS(K)  (=DQ/Q) 

*  TAPEl 1  -  READ  NAMELIST  /DINPL/ 

*  TAPE12  -  WRITE  NAMELIST  /DINPL/ 

PARAMETER  ( IZ=60 , JZ=40 ) 

COMMON  /VECTOR/  DQ ( IZ , JZ , 4 ) , Q( IZ , JZ, 4 ) , F ( IZ , JZ , 4 ) , 

>  G(IZ,JZ,4),  P(IZ, JZ),T(IZ, JZ),E(IZ, JZ),AMW(IZ, JZ), 

>  U(IZ,JZ),V(IZ,JZ),UN(IZ,JZ),VN(IZ,JZ), 

>  ZMU( JZ) ,ZMUT(JZ) ,ZK( JZ) 

COMMON  /COORD/  SAIX ( I Z , JZ ) , SAIY( IZ , JZ ) , ETAX( I Z , JZ ) , 

>  ETAY( IZ, JZ) ,RJ( IZ, JZ),X(IZ, JZ),Y(IZ, JZ), 

DELTAU( IZ, JZ) , Al( IZ, JZ) , A2( IZ, JZ) , A3( IZ, JZ) , 

>  A4(IZ,JZ) 

COMMON  /CONS/  EXI , EYI , THETA, CFL, CFLl , OMEGAX, OMEGAY, AIN, AEX, 

>  RL , RG , AMWO , GAMMAO , REN , PRN , PRNT , TREE , ZMUO , OMEGA , 

>  P0,T0,TWALL,PB, SUM(4) 

COMMON  /INTEG/  I L, JL, I LI , JLl , NBEG, NEND, NADV, NORD, ITIME , 

>  IVISC, IWALL, IWRT 

COMMON  /INPL/  X1(9),Y1(9),F1(9,9),X2(9),Y2(9),F2(9,9), 

>  X3(9) ,Y3(9) ,F3(9,9),X4(9) ,Y4(9) ,F4(9,9) , 

>  X5 ( 9 ) , Y5 ( 9 ) , F5 ( 9 , 9 ) , X6 ( 9 ) , Y6 ( 9 ) , F6 ( 9 , 9 )  , 
::7(9),Y7(9),F7(9,9) 

DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ) ,RHOV( I Z , JZ ) , EO ( IZ , JZ ) 

EQU I VALENCE  ( Q ( 1 , 1 , 1 ) , RHO (1,1)),(Q{1,1,2), RHOU (1,1)), 

>  (Q(l,l,3),RHOV(l,l)), (Q( 1,1,4 ),E0( 1,1)) 
**************************************************************** 

CALL  INITIA 
WRITE  (6,500) 

500  FORMAT (IHl//) 

DO  10  NAD V=NBEG, NEND 
CALL  SOLVE 
CALL  CHECK 
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10  CONTINUE 

WRITE  (6,500) 

CALL  MASS 
WRITE  (6,500) 

CALL  OUTPUT 

STOP 

END 

SUBROUTINE  INITIA 

irie-kie-^-kicic'k-kicit-k'k^ic'k'k’kicic'k'k-k'k'k-k-k-k-k’k-kir-kitit'k'k'k-k’k'k-k^'k-k-k-k'k'k'k’k-k'k'k'k'kiric-k'kic'k'k 

•k 


*  SET  UP  INITIAL  CONDITIONS 

* 

kkk'kkk'k'k-kk'k'k'k'k-k'k-kk’k'k’k'k'k'k'kk-k-kkk-k’kk-k-kie'k’k’k’k-k-k'kkk-kickk’kkk'kk’k'k'k-k'k'k'kkic'k 

PARAMETER  ( IZ=60 , JZ=40 ) 

COMMON  /VECTOR/  DQ ( IZ , JZ , 4 ) , Q( IZ , JZ , 4 ) , F( IZ , JZ , 4 ) , 

>  G(IZ,JZ,4),  P(IZ, JZ),T(IZ,JZ),E(IZ,JZ),AMW(IZ, JZ), 

>  U(IZ, JZ),V(IZ, JZ) ,UN(IZ, JZ),VN(IZ, JZ), 

>  ZMU(JZ),ZMUT(JZ),ZK(JZ) 

COMMON  /COORD/  SAIX( I Z , JZ ) , SAI Y( IZ , JZ ) , ETAX( IZ , JZ ) , 

>  ETAY( IZ, JZ) ,RJ( IZ, JZ) ,X(IZ, JZ) , Y( IZ, JZ) , 

>  DELTAU (IZ,JZ),A1(IZ,JZ),A2(IZ,JZ),A3(IZ,JZ), 

>  A4(IZ,JZ) 

COMMON  /CONS/  EXI , EYI , THETA, CFL, CFLl , OMEGAX, OMEGAY, AIN, AEX, 

>  RL , RG , AMWO , GAMMAO , REN , PRN , PRNT , TREF , ZMUO , OMEGA , 

>  PC,T0,TWALL,PB,SUM(4) 

COMMON  /INTEG/  I L , JL , ILl , JLl , NBEG, NEND, NADV, NORD, ITIME, 

>  IVISC, IWALL, IWRT 

COMMON  /INPL/  Xl(9) ,Y1(9) ,F1(9,9) ,X2(9) ,Y2(9) ,F2(9,9) , 

>  X3(9),Y3(9),F3(9,9),X4(9),Y4(9>,F4(9,9), 

>  X5(9),Y5(9),F5(9,9),X6(9),Y6(9),F6(9,9), 

>  X7(9) ,Y7(9) ,F7(9,9) 

DIMENSION  RHO( IZ, JZ) , RHOU( IZ, JZ) ,RHOV( IZ, JZ) , E0( IZ, JZ) 
EQUIVALENCE  (Q( 1 , 1 , 1 ) , RHO( 1 , 1 ) ) , (Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(1,1,3),RHOV(1,1)),(Q(1,1,4),EO(1,1)) 
DIMENSION  SS(4) 

NAMELIST  /INPUT/  I L , JL , NBEG, NEND, NITER, THETA, NORD, CFL, CFLl , 

>  ITIME, OMEGAX, OMEGAY, AIN, AEX, RL, FST, FSTY, RMl , RM2 , 

>  IVISC, IWALL, RG, AMWO, GAMMAO, CP, REN, PRN, PRNT, TREF, 

>  ZMUO, OMEGA, PO, TO, TWALL,PB, I READ, IWRT, I RUN 
NAMELIST  /DINPL/  XI , Y1 , FI , X2 , Y2 , F2 , X3 , Y3 , F3 , 

>  X4,Y4,F4,X5,Y5,F5,X6,Y6,F6, 

>  X7,Y7,F7 

kk'k'kk-k-k'k'k'k'k'kkk'kkkk'k'k'k'k'k'kk'k'kk'k'kk'kic'kk'k'k'k'k'k'k'k'k'k'k'k'k'k'k'k'kk'k’k'k'k'k'k'k'k'k'kk'k 


*  IF  THE  DIMENSION  IN  COMMON  BLOCK  MUST  BE  CHANGED 

*  PLEASE  CHANGE  THE  PARAMETER  STATEMENT 

* 

.  .  .  IL=TOTAL  GRID  NUMBER  IN  XI  DIRECTION 
.  .  .  JL=TOTAL  GRID  NUMBER  IN  ETA  DIRECTION 
.  . .  NBEG=COUNTING  INDEX  OF  ITERATION  STEP 
=1  FOR  THE  FIRST  RUN 
=ANY  NUMBER  EXCEPT  1  FOR  RERUN 
.  .  .  NEND=NUMBER  OF  ITERATIONS  FOR  THE  FIRST  RUN  ONLY 
.  ..  NITER=NUMBER  IF  ITERATIONS  TO  BE  RUN  WHEN  RERUN  (NBEG.NE.l) 
.  .  .  THETA=ALWAYS  EQUALS  1 
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. . .  NORD=IN  USE  IM  PNS ,  NOT  IN  USE  IN  TLNS 
. . .  CFL^CFL  NUMBER 

. . .  CFL1=CFL  NUMBER  FOR  PNS  MARCHING 
. . .  ITIME=0  FOR  CONSTANT  DT 
=1  FOR  CCNSTAMT  CFL 

. . .  OMEGAX=ARTIFICIAL  DISSIPATION  CONSTANT  IN  XI  DIRECTION 
. . .  OMEGAY=ARTIFICIAL  DISSIPATION  CONSTANT  IN  ETA  DIRECTION 
...  AIN^THE  INLET  RADIUS  FOR  CONICAL  NOZZLE  (IGNORED  IN  IREAD=1) 
...  AEX=THE  EXIT  RADIUS  FOR  CONICAL  NOZZLE  (IGNORED  IF  IREAD=1) 
...  RL=TOTAL  LENGTH  OF  CONICAL  NOZZLE  (IGNORED  IF  IREAD=1) 

...  FST^STRETCHING  FACTOR  IN  XI  DIRECTIO  (0  FOR  UNIFORM  GRID) 
(IGNORED  IN  IREAD=1)  (NOT  IN  USE  IN  TLNS) 

. . .  FSTY=STRETCHING  FACTOR  IN  ETA  DIRECTION  (0  FOR  UNIFORM  GRID) 
(IGNORED  IN  IREAD=1)  (NOT  IN  USE  IN  TLNS) 

. . .  RM1=THE  INITIAL  GUESS  FOR  INLET  MACH  NUMBER 
(IGNORED  IN  IREAD^^l) 

. . .  RM2=THE  INITIAL  GUESS  FOR  EXIT  MACH  NUMBER 
(IGNORED  IN  IREAD=1) 

...  IVISC=0  INVISCID  FLOW 
=1  VISCOUS  FLOW 
. . .  I WALL-0  FOR  ADIABATIC  WALL 

=1  FOR  CONSTANT  WALL  TEMPERATURE 
. . .  RG=UNIVERSAL  GAS  CONSTANT  (NOT  IN  USE  IN  PNS  SOLUTION) 

. . .  AMWO=MOLECULAR  WEIGHT  IN  STAGNATION  CHAMBER 
(NOT  IN  USE  IN  PNS) 

...  GAMMAO=SPECIFIC  HEAT  RATIO  (STAGNATION  CHAMBER  VALUE  WHEN 
USED  FOR  RFAL  CASES  IN  TLNS) 

. . .  CP=CONSTANT  PRESSURE  SPECIFIC  HEAT  (NOT  IN  USE  IN  TLNS) 

.  .  .  REN=REYNOLDS  NUMBER 

(CAN  BE  SWITCH  ON  OR  OFF  IN  THIS  SUBROUTINE) 

. . .  PRN=PRANDTL  NUMBER 
. . .  PRNT=TURBULENT  PRANDTL  NUMBER 
:=0.  FOR  LAMINAR  FLOW 
=0.9  FOR  TURBULENT  FLOW 

. . .  TREF=THE  REFERENCE  TEMPERATURE  FOR  VISCOSITY  CALCULATION 
.  .  .  ZMU0=THE  VISCOSITY  AT  T=TREF 
.  .  .  OMEGA=EXPONENTIAL  VISCOSITY  LAW 
. . .  P0=STAGNATI0N  PRESSURE 
. . .  TO=STAGNATION  TEMPERATURE 

. . .  TWALL=GIVEN  WALL  TEMPERATURE  FOR  IWALL=1 
. . .  PB=THE  BACK  PRESSURE  AT  THE  EXIT  OF  NOZZLE 

=0.  (SUBSONIC  FLOW  EXTRAPOLATED  FROM  INTERIOR) 

=THE  SPECIFIED  BACK  PRESSURE  (FIXED  THE  PRESSURE  FOR 
SUBSONIC  PORTION  AT  EXIT) 

.  .  .  IREAD=0  FOR  DEFAULT  CONICAL  NOZZLE 
=1  READ  GRID  FROM  DATA  FILE 
.  .  .  IWRT=1  PRINTING  OF  FLOWFIELD  RESULTS 

=0  NO  PRINTING  OF  FLOWFIELD  RESULTS 
.  .  .  IRUN=0  FOR  1ST  RUN 
* 

*  READ  INPUT  DATA 

* 

READ  (1, INPUT) 

READ  (11,DINPL) 

IRUN=IRUN+1 
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IL1=IL-1 

JL1=JL-1 

★ 

*  READ  GRID  FROM  DATA  FILE 

★ 

IF( IREAD.EQ. 1)  THEN 

READ  (3,501)  ((X(I, J),Y(I,J),I=1,IL),J=1,JL) 
501  FORMAT(E17.9,4E16.9) 

ELSE 
END  IF 

* 

*  COORDINATE  TRANSFORMATION 

* 

EXI=^1.0 
EYI  =  1 .0 
DO  30  1=1, IL 
IP1=I+1 
IM1=I-1 

IF(I.EQ.l)  IM1=1 
IF(I.EQ.IL)  IP1=IL 
DSAI=2 . *EXI 

IF( I . EQ. 1 . OR. I . EQ. IL)  DSAI=EXI 

DO  30  J=1,JL 

JP1=J+1 

JM1=J-1 

IF(J.EQ.l)  JM1=1 
IF(J.EQ.JL)  JP1=JL 
DETA=2 . *EYI 

IF( J.EQ. l.OR. J.EQ. JL)  DETA=EYI 
XSAI=(X( IPl, J)-X( IMl, J) )/DSAI 
YSAI=(Y( IPl, J)-Y(IM1, J) )/DSAI 
XETA=(X(I, JP1)-X(I, JMl) )/DETA 
YETA=(Y(I, JP1)-Y(I,JM1) )/DETA 
IF(J.EQ.l)  THEN 

XETA=XETA-0 . 5* (X( I , J) -2 . *X( I , J+1 ) +X( I , J+2 ) ) 
YETA=YETA-0 . 5* ( Y ( I , J ) -2 . *Y( I , J+1 ) +Y( I , J+2 ) ) 
ELSE 
END  IF 

* 

*  JACOBIAN  IS  DEFINED  AS  - 

* 

*  - 1 

*  J=(X  *Y  -X  *Y  ) 

*  SAI  ETA  ETA  SAI 

•k 

RJP=XSAI * YETA-XETA* YSAI 
RJ(I, J)=1./RJP 
SAIX(I, J)=YETA/RJP 
SAIY( I , J)=-XETA/RJP 
ETAX( I , J)=-YSAI/RJP 
ETAY( I , J)=XSAI/RJP 
30  CONTINUE 

* 

*  CALCULATE  METRIC  TERMS  AT  MID  POINTS 
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CALL  MCONST 

INITIALIZATION  -  COMPUTE  Q(I,J,K) 


^  GIVE  THE  INITIAL  VALUE  OF  VISCOSTY 
^  IF  THE  VISCOSITY  AT  T=TREF  IS  GIVEN  FROM  INPUT 

^  THE  CALCULATION  FOR  ZMUO  MUST  BE  SWITCHED  OFF 

GM1=GAMMA0-1 . 

R=RG/AMW0 

CV=CP/GAMMAO 

TIN=T0/( 1 . +0 . 5*GM1*RM1**2 ) 

UIN=RM1*SQRT(GAMMA0*R*TIN) 

PIN=P0* (TIN/TO )**(GAMMA0/GM1 ) 

RIN=PIN/(R*TIN) 

ZMU0=(RIN*UIN*Y(1)*2 . ) /REN 

f 

•  SKIP  TO  RERUN  THE  CODE 

IF( IRUN.NE. 1)  GO  TO  100 
DO  40  1=1, IL 
IF(I.EQ.l)  THEN 
AMWS=AMW0 
GAMMA=GAMMA0 
GM1=GAMMA-1. 

R0=P0/ ( RG/AMWS ) /TO 
END  IF 

42  RM=RM1  +  FL0AT( I - 1 )/FLOAT ( I  LI ) * ( RM2-RM1 ) 

GMM=1 . +0 . 5*GM1*RM**2 
TS=T0/GMM 

PS=P0/GMM*  * ( GAMMA/GMl ) 

RS=PS/ ( RG/AMWS ) /TS 
IF(I.EQ.l)  THEN 

WRITE  (6,504)  TS , PS , RS , AMWS, GAMMA 
504  FORMAT (// 1 X, '  TS=',E11.5,'  PS=',E11.5,'  RS=',E11.5, 

>  16X,  '  AMW=' ,E11.5, ’  GAMMA=’ ,E11.5) 

41  TS1=TS 

PS1=PS 

RS1=RS 

ES=FE(RS,TS) 

AMWS=FAMW(RS,TS) 

GAMMA=1 . + ( RG/AMWS ) / ( ES/TS ) 

GM1=GAMMA-1 

GMM=1 . +0 . 5*GM1*RM**2 

TS=T0/GMM 

PS=P0/GMM** (GAMMA/GMl ) 

RS=PS/ ( RG/AMWS ) /TS 

WRITE  (6,503)  TS, PS, RS, ES, AMWS, GAMMA 
503  F0RMAT(1X,'  TS=',E11.5,'  PS=',E11.5,’  RS=',E11.5, 

>  '  ES=',E11.5,'  AMW=' ,E11.5, '  GAMMA= ' , Ell . 5 ) 

IF(ABS(TS-TS1) .GT. l.E-5.0R.ABS(PS-PSl) . GT . 1 . E-5 . OR . 

>  ABS(RS-RSl) -GT. l.E-5)  GO  TO  41 
END  IF 

ES=FE(RS, TS) 
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C0=SQRT ( FC02 ( PS , RS , TS , ES , AMWS ) ) 

UU=RM*CO 
DO  40  J=1,JL 

I F ( I . EQ . 1 . OR . I . EQ . I L )  THEN 

IF(I .EQ. 1)  SL0PE={Y{I+1, J)-Y(I, J) )/( X( I +1 , J ) -X( I , J ) ) 
IF( I .EQ. IL)  SLOPE=(Y( I, J)-Y( I-1,J))/(X(I,J)-X(I-1,J)) 
ELSE 

SLOPE=(Y( I+l, J)-Y( I-l, J) )/(X( I+l, J)-X( I-l, J) ) 

END  IF 

DENOM=SQRT( 1 . +SLOPE* SLOPE ) 

U( I , J ) =UU/DENOM 
V  (  I  ,  J  )  =irU*  SLOPE/DENOM 

UN( I, J)=SAIX( I, J)*U(I, J)+SAIY(I, J)*V( I, J) 

VN( I, J)=ETAX( I, J)*U(I, J)+ETAY(I, J)*V(I, J) 

* 

*  SLIP  INITIAL  CONDITION,  IVISC=0 

* 

IF( J.EQ. JL.AND. IVISC.EQ.O)  THEN 
U( I , J)=UU/DENOM 

V ( I , J ) =-ETAX ( I , J ) /ETAY ( I , J ) *U( I , J ) 

UN(I, J)=U(I, J)*SAIX(I, J)+V(I, J)*SAIY(I, J) 

VN( I , J)=0. 

END  IF 

* 

*  NO-SLIP  INITIAL  CONDITION,  IVISC=1 

* 

IF( J.EQ. JL.AND. IVISC.EQ. 1)  THEN 
U( I , J)=0. 

V(I, J)=0. 

UN{I, J)=0. 

VN( I , J)=0. 

END  IF 

AMW( I , J)=AMWS 
E( I, J)=ES 
T( I , J)=TS 

P( I , J)=PO/(TO/T( I , J) )** (GAMMA/GMl) 

IF( J.EQ. JL.AND. IVISC.EQ. 1)  THEN 
IF( IWALL.EQ. 1)  T(I,J)=TWALL 
P(I, J)=P(I, J-1) 

IF(I .EQ. IL.AND.PB.NE.0.0)  P(I, J)=PB 
ELSE 
END  IF 

RHO(I, J)=P( I, J)/(RG/AMW(I, J) )/T(I, J) 

RHOU{I, J)=RHO(I, J)*U(I, J) 

RHOV(I, J)=RHO(I, J)*V(I, J) 

EO(I, J)=RHO(I, J)*(E(I, J)+0.5*(U(I, J)**2+V(I, J)**2) ) 

40  CONTINUE 

★ 

*  INITIALIZATION  -  COMPUTE  DELTAU(I,J) 

* 

EIGMAX=0. 

DO  50  1=1, IL 
DO  50  J=1,JL 

CO=SQRT ( FC02 ( P ( I , J ) , RHO (I,J),T(I,J),E(I,J), AMW ( I , J ) ) ) 
CX=SQRT(SAIX(I, J)**2+SAIY(I, J)**2) 
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C Y= SQRT ( ET AX ( I , J ) *  *  2  +ETAY ( I , J ) *  *  2 ) 

CX=(UN{ I , J)+CX*C0)/EXI 
CY-{VM( I, J)+CY*C0)/EYI 
EIGNN=ABS(CX) 

IF(EIGNN.LE.ABS(CY) )  EIGNN=ABS(CY) 

IF{ ITIME.EQ. 1)  GO  TO  55 
IF(CX.GE.EIGMAX)  EIGMAX=CX 
IF(CY.GT.EIGMAX)  EIGMAX=CY 
55  DELTAU( I , J)=CFL/EIGNN 
50  CONTINUE 

WRITE  (6, INPUT) 

WRITE  (2, INPUT) 

WRITE  (6,DINPL) 

IF( ITIME.EQ. 1)  RETURN 
DO  60  1=1, IL 
DO  60  J=1,JL 
DELTAU ( I , J ) =CFL/E I GMAX 
60  CONTINUE 
RETURN 
100  CONTINUE 

* 

*  READ  FLOWFIELD  DATA,  (NBEG,  NEND  ARE  DETERM I ND  BY  NDUM) 

* 

70  READ  (9,502,END=65)  NDUM, ( SS ( K) , K=1 , 4 ) 

502  F0RMAT(I5,3X,4(1X,E14.7) ) 

WRITE  (10,502)  NDUM, (SS(K) ,K=1,4) 

GO  TO  70 
65  CONTINUE 
NBEG=NDUM+1 
NEND=NBEG+N I TER- 1 

READ  (7)  ( (DELTAU( I , J) , 1=1, IL) , J=l, JL) 

READ  (7)  ( (RHO(I, J),RHOU(I, J),RHOV(I, J),E0(I, J), 

>  1=1, IL) , J=l, JL) 

DO  80  1=1, IL 
DO  80  J=1,JL 

U(I, J)=RHOU(I, J)/RHO( I, J) 

V( I , J)=RHOV( I , J)/RHO( I , J) 

UN( I , J)=U( I , J)*SAIX( I , J)+V( I , J)*SAIY( I, J) 

VN(I, J)=U(I, J)*ETAX(I, J)+V(I, J)*ETAY(I, J) 

E( I, J)=E0(I, J)/RHO(I, J)-0.5*(U(I, J)**2+V(I, J)**2) 

T(I, J)=FT(RHO(I, J),E(I, J)) 

AMW ( I , J ) =  F AMW ( RHO (I,J),T(I,J)) 

P ( I , J ) =RHO { I , J ) * ( RG/AMW (I,J))*T(I,J) 

80  CONTINUE 

•k 

*  CHANGES  IN  /INPUT/  PUT  HERE  AND  ADD  -  WRITE  (2, INPUT) 

* 

WRITE  (6, INPUT) 

WRITE  (6,DINPL) 

RETURN 

END 

SUBROUTINE  SOLVE 

**************************************************************** 


SOLVE  SUBROUTINE 
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•k'k'k'kic-^ie'^-ie'k'kiric'k-kir'k-^'k’k'k-k'k’k'k'k-k'k'k-k-k-k-k'kie'k'k-k'k'k'kicif'/e'k'k'k'kie'k'k'k-k'fr-k’kie’k'k'k'k'kie'k 

PARAMETER  ( I Z=60 , JZ=40 ) 

COMMON  /VECTOR/  DQ( IZ, JZ, 4) , Q( IZ, JZ, 4) , F( IZ, JZ, 4) , 

>  G(IZ,JZ,4),  P( IZ, JZ) ,T( IZ, JZ) ,E( IZ, JZ) , AMW( IZ, JZ) , 

>  U(IZ, JZ) ,V(IZ, JZ) ,UN(IZ, JZ),VN(IZ, JZ), 

>  ZMU( JZ) ,ZMUT( JZ) ,ZK( JZ) 

COMMON  /COORD/  SAIX( IZ, JZ) , SAIY( IZ, JZ) , ETAX( IZ, JZ) , 

>  ETAY(IZ, JZ),RJ(IZ, JZ),X(IZ,JZ),Y(IZ,JZ), 

>  DELTAU ( I Z , JZ ) , A1 ( I Z , JZ ) , A2 ( I Z , JZ ) , A3 ( I Z , JZ ) , 

>  A4(IZ,JZ) 

COMMON  /CONS/  EXI , EYI , THETA, CFL, CFLl , OMEGAX, OMEGAY, AIN, AEX, 

>  RL , RG , AMWO , GAMMAO , REN , PRN , PRNT , TREE , ZMUO , OMEGA , 

>  PO,TO,TWALL,PB, SUM(4) 

COMMON  /INTEG/  IL , JL , I  LI , JLl , NBEG, NEND, NADV, NORD, ITIME , 

>  IVISC, IWALL, IWRT 

DIMENSION  RHO( IZ, JZ) ,RHOU( IZ , JZ ) , RHOV( IZ, JZ ) , EO ( IZ , JZ ) 

EQUIVALENCE  ( Q ( 1 , 1 , 1 ) , RHO ( 1 , 1 ) ) , ( Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(1,],3),RH0V(1,1)), (Q( 1,1,4), E0( 1,1)) 

JEND=JL 

IF( IVISC. EQ. 1)  JEND=JL1 

* 

*  FORWARD  SWEEP 


*  RHS  CALCULATIONS 

* 

DO  20  1=2, IL 
CALL  RHSEF(I) 

IF( IVISC. EQ. 1)  THEN 
CALL  MULAM(I) 

IF( PRNT. NE. 0.0)  CALL  MUTUR(I) 

CALL  KLAM( I ) 

IF( PRNT. NE. 0.0)  CALL  KTUR{I) 

CALL  RHSVS(I) 

END  IF 
CALL  RHSH( I ) 

* 

*  CALCULATE  RESIDUAL 

* 

DO  20  J=1,JL 
DO  20  K=l,4 

DQ( I, J,K)=-DELTAU( I, J)*DQ( I, J,K) 

20  CONTINUE 

* 

*  ADD  SAI  DIRECTION  4TH  ORDER  ARITFICIAL  VISCOSITY 

* 

IF(OMEGAX.NE.O.O)  CALL  ADDX 

* 

*  ADD  ETA  DIRECTION  4TH  ORDER  ARITFICIAL  VISCOSITY 

* 

IF(OMEGAY.NE.O.O)  CALL  ADDY 
DO  30  1=2, IL 
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STA 


SOLVE  L-ETA  OPERATOR 
CArj,  COEFY(T) 

UPDATE  VARIAFLES  FORWARD  SWEEPT 

DO  40  J:=2,JEND 
RJJ=RJ( I , J)/Y( I , J) 

DO  45  K=l,4 

Q{I,  J.K)=0(I, J,K)+DQ(I, J,K)*RJJ 
45  CONTINUE 

U ( I , J ) =RKOU ( I , J ) /RHO ( I , J ) 

V( I , J)=RHOV( I , J)/RHO( I , J) 

UN( I, J)=SAIX(I, J)*U(I, J)+SAIY(I, J)*V(I, J) 

VN ( I , J ) ^U ( I , J ) *  ETAX ( I . J ) +ETAY {I,J)*V(I,J) 

E(I, J)=E0(I, J)/RHO(I, J)-0.5*(U(I, J)**2+V(I, J)**2) 
T ( I , J ) =FT ( RHO (I,J),E(I,J)) 

AMW ( I , J ) =FAMW ( RHO (I,J),T(I,J)) 

P ( I , J ) =RHO ( I , J ) * ( RG /AMW (I,J))*T(I,J) 

40  CONTINUE 

CALL  MULAM(I) 

CENTERLINE  BOUNDARY  CONDITIONS 
CALL  CLBC( I ) 

WALL  BOUNDARY  CONDITIONS 

IF( IVISC. EO. 1 )  CALL  WALLBC(I) 

30  CONTINUE 

BACKWARD  SWEEPT 


RHS  CALCULATIONS 

DO  70  IB=2, ILl 
I=ILl-IB+2 
CALL  RHSEF(I) 

IF ( IVISC. EQ. 1)  THEN 
CALL  MULAM( I ) 

IF(PRNT.NE.O.O)  CALL  MUTUR(I) 

CALL  KLAM( I ) 

IF(PRNT.NE.O.O)  CALL  KTUR(I) 

CALL  RHSVS(I) 

END  IF 
CALL  RHSH(I) 

CALCULATE  RESIDUAL 

DO  70  J=1,JL 
DO  70  K=l,4 

DQ(I, J,K)=-DELTAU(I, J)*DQ(I, J,K) 

70  CONTINUE 

ADD  SAI  DIRECTION  4TH  ORDER  ARTIFICIAL  VISCOSITY 
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IF(OMEGAX.NE.O.O)  CALL  ADDX 

★ 

*  ADD  ETA  DIRECTION  4TH  ORDER  ARTIFICIAL  VISCOSITY 

★ 

IF(OMEGAY.NE.O.O)  CALL  ADDY 
DO  80  IB=2, ILl 
I=IL1- IB+2 

* 

*  SOLVE  L-ETA  OPERATOR 

★ 

CAI.L  COEFY(I) 

■*< 

*  UPDATING  VARIABLES  BACKWARD  SWEEP 

★ 

DO  90  J=2,JEND 
RJJ=RJ(I, J)/Y(I, J) 

DO  95  K=l,4 

Q(I, J,K)=Q(I, J,K)+DQ(I, J,K)*RJJ 
95  CONTINUE 

U(I, J)=RHOU(I, J)/RHO(I, J) 

V(I, J)-RHOV(I, J)/RHO(I, J) 

UN(I, J)=U(I, J)*SAIX(I, J)+V(I, J)*SAIY(I, J) 

VN(I, J)=U(I, J)*ETAX(I, J)+V(I, J)*ETAY(I, J) 

E(I, J)=E0(I, J)/RHO(I, J)-0.5*(U(I, J)**2+V(I, J)**2) 
T(I,J)=FT(RHO(I,J),E(I,J)) 

AMW(I, J)=FAMW(RHO(I, J),T(I, J)) 

P ( I , J ) =RHO ( I , J ) * ( RG/AMW (I,J))*T(I,J) 

* 

*  UPDATING  DELTAU(I,J) 

★ 

CC=-SQRT(FC02(P(  I,  J)  ,RHO(  I,  J)  ,T(I,  J),E(  I,  J)  ,AMW(  I,  J)  )  ) 
CX=SQRT(SAIX( I, J)**2+SAIY( I, J)**2) 

CY=SQRT(ETAX( I, J)**2+ETAY( I, J)**2) 

CX=(UN( I , J)+CX*C0) 

CY=(VN(I, J)+CY*C0) 

EIGNN=ABS(CX) 

IF(EIGNN. LE. ABS(CY) )  EIGNN=ABS(CY) 

DELTAU( I , J)=ITIME*CFL/EIGNN+(1-ITIME)*DELTAU( I , J) 

90  CONTINUE 

* 

*  CENTERLINE  BOUNDARY  CONDITIONS 

* 

CALL  CLBC(I) 

* 

*  WALL  BOUNDARY  CONDITIONS 

•k 

IF( IVISC.EQ. 1)  CALL  WALLBC(I) 

80  CONTINUE 
RETURN 
END 

SUBROUTINE  COEFY(I) 

kkk-kk'kkk’k'kkkkk'kkk'k'k'k'k'kkk’kkk'k'k'kit'kkie’k'k'kir'k'k'kiekk'kir'k'k'k'k'k'k'k'kk'k'k'k'k'k'kk-kic 

k 

*  SETTING  COEFFICIENTS  FOR  LY- OPERATOR 
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'k-k'k'k'k'k-k'k-k'k-k'k-k'k-k'k-k-k'k'k’k-k-k'k-k'kif'k'k-k-k'k-k'k'k’k'fc-k-k'k-k'k'k-k-k'k'k'fe'k'k-krk'kif'k'k'kic'k'k’k’k-k'k 

PARAMETER  ( I Z=60 , JZ=40 ) 

COMMON  /VECTOR/  DQ ( I Z , JZ , 4 ) , Q ( I Z , JZ , 4 ) , F ( I Z , JZ , 4 ) , 

G(IZ,JZ,4),  P( IZ, JZ) ,T(IZ, JZK E( IZ, JZ) ,AMW( IZ, JZ) , 

>  U( IZ, JZ) , V( IZ, JZ) ,UN( IZ, JZ) , VN( IZ, JZ) , 

>  ZMU( JZ) , ZMUT( JZ) , ZK( JZ) 

COMMON  /COORD/  SAIX ( I Z , JZ ) , SAI Y( I Z , JZ ) , ETAX ( I Z , JZ ) , 

>  ETAY( IZ, JZ) ,RJ( IZ, JZ) ,X( IZ, JZ ) , Y( IZ, JZ) , 

>  DELTAU( IZ, JZ) , A1 ( IZ, JZ) , A2{ IZ, JZ) , A3 ( IZ, JZ) , 

>  A4(IZ,JZ) 

COMMON  /CONS/  EX  I ,  EY I  ,  THETA ,  CFL ,  CF  l.1  ,  uMEGaX  ,  OMEGAY ,  AIN ,  AEX , 
R  L , RG , AMWO , GAMMAO , REN , PRN , PRNT , TRE  F , ZMUO , OMEGA , 

>  PO,TO,TWALL,PB, SUM(4) 

COMMON  /INTEG/  I L , JL , I  LI , JLl , NBEG, NEND , NADV , NORD , ITIME , 

>  IVISC, IWALL, IWRT 

DIMENSION  RHO( IZ, JZ) , RHOU( IZ, JZ) , RHOV( I Z , JZ ) , EO ( I Z , JZ ) 
EQUIVALENCE  ( Q( 1 , 1 , 1 ) , RHO ( 1 , 1 ) ) , (Q(l, 1, 2 ) ,RH0U(1, 1) ) , 
(Q(1,1,3),RH0V(1,1)), (Q( 1,1,4 ),E0( 1,1)) 
DIMENSION  IN(4) ,EE(4,4, JZ) ,EL(4, JZ) ,W(4, JZ) 

DIMENSION  AM(4, 4) ,BM(4, 4) ,CM(4,4) ,DM(4) 

DIMENSION  AL(4, 4) ,BE(4) ,DTEMP(4) , ISUB( JZ) 

DIMENSION  B(4,4) ,BL1(4,4) ,D(4,4) ,A(4,4) , AJM(4,4) 

DATA  I  SUB  /JZ*0/ 

*********************************************'*’  +  -v**************** 


CHECK  THE  SONIC  POINT  AT  DOWNSTREAM  END 

IF( IVISC, NE. 1)  GO  TO  5 
I F  (  I  .  NE  .  I L )  GO  TO  5 
DO  10  J=1,JL 

C0=SQRT(FC02(P( I , J) ,RHO( I , J ) , T( I , J ) , E ( I , J ) , AMW ( I , J) ) ) 
CONTRA=UN( I , J)-SQRT(SAIX( I , J ) **2+SAI Y ( I , J)**2 )*C0 
I F( CONTRA. LT. 0.0)  THEN 
ISUB( J)=] 

ELSE 

ISUB( J)=0 
END  IF 

IF(PB.EQ.O.O)  ISUB(J)=0 
10  CONTINUE 
5  CONTINUE 

ON  THE  CENTER  LINE  OF  THE  NOZZLE  AT  J=1 
J=1 

CALL  SZER0(4,AM) 

CALL  SZER0{4,BM) 

DO  15  M=l,4 
DM(M)=0. 

BM(M,M)^BM(M,M)+1.0 
15  CONTINUE 

CALL  SZER0(4,CM) 

CALL  EEL( J,4, JL,EE,EL, AM,BM,CM,DM, IN,AL,BE) 

INTERIOR  NODS 
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DO  20  J=2,JL1 

TAUD=0 . 50*DELTAU( I , J ) *THETA/EYI 
TAUD2-2 . *TAUD 

JPl  - 

CALL  JCBAB( 2 , 0, B, I , JMl ) 

CALL  SMM(4,TAUD,B,AM) 

CALL  SZER0(4,BM) 

DO  25  M=--l,4 

BM(M,M)=BM(M,M)+1. 

25  CONTINUE 

CALL  JCBABFM(1, 1,0,A, I, J) 

CALL  JCBABPM(1,2,0,AJM, I, J) 

CALL  JCBD(D, I , J) 

DO  30  M=l,4 
DO  30  N=l,4 

BM(M,M)=BM(M,N)-TAUD2*(D(M,N)-A(M,N)+AJM(M,N) ) 

30  CONTINUE 

CALL  JCBAB(2,0,B, I, JPl) 

CALL  SMM( 4, -TAUD,B,CM) 

INSERT  VISCOUS  JACOBIAN  LHS  HERE 

IF( IVISC.EQ. 1)  THEN 

CALL  JCBMVS(A,B,D, I, J) 

DO  35  M=l,4 
DO  35  N=1 , 4 

AM(M,N)=AM(M,N)-DELTAU(I, J)*A{M,N) 
BM(M,N)=BM(M,N)+DELTAU( I , J)*B(M,N) 
CM(M,N)=CM(M.N)-DELTAU( I, J)*D(M,N) 

35  CONTINUE 
ELSE 
END  IF 
DO  40  K=l,4 
DM(K)=DQ( I, J,K) 

40  CONTINUE 

DOWNSTREAM  BOUNDARY  CONDITIONS  FOR  VISCOUS  FLOW 

IF( IVISC.EQ. 1 .AND. ( I -EQ. IL.AND. ISUB(J) .EQ. 1) )  THEN 
CALL  TMPM(1,0,BL1, I, J) 

DO  45  K=l,4 
BL1(4,K)=0. 

45  CONTINUE 

CALL  MMM(4,BL1, AM,A) 

CALL  MMM(4,BL1,BM,B) 

CALL  MMM(4,BL1,CM,D) 

DO  50  M=l,4 
DO  50  N-1,4 
AM(M,N)=A(M,N) 

BM(M,N)=B(M,N) 

CM(M,N)=D{M,N) 

50  CONTINUE 

DO  55  M=l,4 
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DTEMP(M)=0 . 

DO  55  K=l,4 

DTEMP(M)=DTEMP(M) +BL1 (M, K)*DM(K) 

55  CONTINUE 

DO  60  M=l,4 
DM(M)=DTEMP(M) 

60  CONTINUE 

AR-FAR(P( I, J) ,RHO( I , J ) , T ( I , J ) , E ( I , J ) , AMW ( I , J ) ) 

AE-FAE  (  P  (  I  ,  J )  ,  RHO  (I,J),Tn,J),E{I,J),  AMW  (  I ,  J  )  ) 
AER=AE/RHO( I , J) 

DPDR=AR+AER* ( -E0( I , J )/RHO( I,J)+(U(I,J)**2+V(I,J)**2)) 
DPDU=-AER*U( I , J) 

DPDV=-AER*V( I , J) 

DFDE-AER 

BM(4, 1 )=DPDR/Y( I , J) 

BM(4, 2 )=DPDU/Y( I , J) 

BM(4, 3 )^DPDV/Y( I , J) 

BM(4, 4)=DPDE/Y( I , J) 

IF(PB.NE.O.O)  THEN 

DM( 4)=(PB-P( I , J) )/RJ( I , J) 

ELSE 

DM(4)=0. 

END  IF 
ELSE 
END  IF 

CALL  EEL(J,4, JL,EE,EL,AM,BM,CM,DM, IN,AL,BE) 

20  CONTINUE 

WAr,L  BOUNDARY  CONDITIONS  FOR  INVISCID  FLOW,  EULER  EQS . 
J=JL 

TAUD=THETA*DELTAU( I , J)/EYI 
IF( IVISC.EQ. 1)  GO  TO  65 
CALL  SZERO(4,AM) 

CALL  JCBAB(2,0,B, I, J-1) 

CALL  JCBABPM(1, 1,0,A, I, J) 

CALL  JCBABPM( 1, 2,0, AJM, I , J) 

CAI.L  TMFM(2,0,BL1,  I,  J) 

DO  70  M-^1,3 
DO  70  N=l,4 
DO  70  K=l,4 

AM(M,N)=AM(M,N)+TAUD*BL1(M,K)*B(K,N) 

70  CONTINUE 

CALL  SZERO(4,BM) 

CALL  JCBAB(2, 0, B, I , J) 

CALL  JCBD(D, I , J) 

DO  75  M=l,3 
DO  75  N=l,4 

BM(M,N)=BM(M,NUBL1(M,N) 

DO  75  K=l,4 
BM(M,N)=BM(M,N) 

>  ■*-TAUD*BL1(M,K)*(B(K,N)+A(K,N)-D(K,N)-AJM(K,N)  ) 

75  CONTINUE 

BM(4, 1)=-VN( I, J) 

BM(4,2)=ETAX(I, J) 
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BM(4, 3 )=ETAY( 1 , J) 

BM ( 4 , 4 ) =0 . 

CALL  SZERO(4,CM) 

DO  80  M^l,3 
DM  ( M )  ^-0  . 

DO  80  ID- 1,4 

DM(M)-DM{M)  t-BLl(M,K)*DQ(  I,  J,K) 

80  CONTINUE 
DM(  4)^-0  . 

GO  TO  85 
65  CONTINUE 

CALL  SZER0(4,AM) 

CALL  SZERO(4,BM) 

CALL  SZERO(4,CM) 

DO  90  M=l,4 
DM(M)=0 . 

90  BM(N,M):=1.0 
85  CONTINUE 

CALL  EEL( J  4, JL,EE,EL, AM,BM,CM,DM, IN, AL,BE) 

•k 

*  SOLVE  4-4  BLOCK  TRIDIAGONAL  MATRICS 

■fr 

CALL  SOLU(W, JL, 4, EE, EL) 

DO  95  J^1,JL 

DO  95  K=l, 4 

DO ( I , J , K ) =W ( K , J ) 

95  CONTINUE 
RETURN 
END 

SUBROUTINE  BC 

***★*■*•*  ••:*■*:*********  ********************************************* 

* 

*  SUBROUTINE  FOR  BOUNDARY  CONDITIONS 

★ 

**************************************************************** 
PARAMETER  { I Z=60 , JZ=40 ) 

COMT-TOM  /VECTOR/  DQ (  I Z ,  JZ ,  4 )  ,  Q(  IZ ,  JZ ,  4 )  ,  F (  I Z ,  JZ ,  4 )  , 

G(IZ,JZ,4),  P(IZ,  JZ),T(IZ,JZ),E(IZ,JZ),AMW(IZ, JZ), 

U( IZ, JZ) , V( IZ, JZ) ,UN( IZ, JZ) ,VN( IZ, JZ) , 

^  ZMU( JZ) ,ZMUT(JZ),ZK(JZ) 

COMMON  /COORD/  SAIX( I Z , JZ ) , SAI Y( IZ , JZ ) , ETAX ( IZ , JZ ) , 

ETAY ( I Z , JZ ) , R J ( I Z , JZ ) , X ( I Z , JZ ) , Y ( I Z , JZ ) , 

DELTAU( IZ, JZ) , A1 ( IZ, JZ) ,A2( IZ, JZ) , A3(IZ, JZ) , 
A4(IZ,JZ) 

COMMON  /CONS/  EX I , EYI , THETA , CFL, CFLl , OMEGAX , OMEGAY, AIN, AEX , 

>  RL , RG , AMWO , GAMMAO , REN , PRN , PRNT , TREF , ZMUO , OMEGA , 

PO , TO , TWALL , PB , SUM ( 4 ) 

COMMON  /INTEG/  I L , JL , I LI , JLl , NBEG, NEND, NADV, NORD , ITIME , 

>  IVISC, IWALL, IWRT 

DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ) ,RHOV( IZ, JZ) , E0( IZ, JZ) 
EQUIVALENCE  (Q( 1, 1, 1) ,RHO( 1, 1) ) , (Q( 1, 1,2) ,RH0U(1, 1) ) , 
(Q(1,1,3),RH0V(1,1)), (Q(1,1,4),E0(1,1)) 
***************************************************************** 

ENTRY  CLBC(II) 

*****  *********************************************************** 
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CENTER  LINE  BOUNDARY  CONDITIONS 
I  =  I  I 

THE  QUANTITIES  EXTRAPOLATED  ARE  U,  RHO,  EO  AND  LET  V=0 

SY=SAIY( 1,1) 

EY=ETAY( 1,1) 

DENOM=SY-l . 5*EY 
IF(I.EQ.l)  THEN 
UIM1=0. 

RHOIM1=0. 

E0IM1=0. 

ELSE 

UIM1=U( I-l,  1) 

RHOIMl=RHO( I-l, 1) 

E0IM1=E0( I-l, 1) 

END  IF 

U( I , 1 )=(SY*UIMl-0. 5*EY*(4. *U( I,2)-U( 1,3)) )/DENOM 
V ( I , 1 ) =0 . 

UN(I,1)=SAIX(I,1)*U(I,1) 

VN ( I , 1 ) =ETAX (I,1)*U(I,1) 

RHO(I, 1)=(SY*RHOIM1-0.5*EY*(4.*RHO(I,2)-RHO(I,3) ) )/DEN0M 
EO(I, 1)=(SY*E0IM1-0.5*EY*(4.*E0(I,2)-E0(I,3) ) )/DENOM 
E( I , 1)=E0{ I, 1)/RH0( I, l)-0. 5*(U(I, 1)**2+V( I , 1)**2) 
T(I,1)=FT(RH0(I,1),E(I,1)) 

AMW (1,1) =FAMW ( RHO (I,1),T(I,1)) 

P( I , 1)=RH0( I , 1)*(RG/AMW( I , 1) )*T( I, 1) 

RHOU( I, 1)=RH0( I, 1)*J( I,  1) 

RH0V(I,1)=RH0(I,1)*V(I,1) 

RETURN 

ENTRY  WALLBC(II) 


WALL  BOUNDARY  CONDITIONS  FOR  VISCOUS  FLOW 

I  =  I  I 
J=JL 

CC1=ETAX(I, J)*SAIX( I, J)+ETAY(I, J)*SAIY(I, J) 
CC2=ETAX( I, J)**2+ETAY( I , J)**2 
IF(I.NE.IL)  THEN 
AM=-0. 5*CC1 
BM=1 . 5*CC2 
CM=0. 5*CC1 

DM=CC2*(2.*P( I, J-1)-0.5*P( I, J-2)  ) 

ELSE 

AM=-CC1 

BM=CC1+1 . 5*CC2 
CM=0. 

DM=CC2*(2.*P(I, J-1)-0.5*P(I, J-2)) 

END  IF 
IP1=I+1 

IF(I.EQ.IL)  IP1=IL 
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*  LAMINAR  VISCOSITY  CALCULATION 

* 

I  =  II 

* 

*  USE  SUTHELAND  LAW 

* 

DO  10  J=1,JL 
TOS=TREF+SCONST 
TT=T{ I , J) 

TTS=TT+SCONST 

ZMU ( J ) =ZMU0*T0S/TTS* { TT/TREF ) *  * 1 . 5 

* 

*  USE  CONSTANT  VISCOSITY 

* 

ZMU( J)=ZMU0 

* 

*  USE  EXPONENTIAL  VISCOSITY  LAW 

* 

ZMU ( J ) =ZMU0  * ( TT/TREF ) *  *  OMEGA 

* 

*  USE  DATA 

★ 

ZMU ( J ) =FZMU ( RHO ( I , J ) , E ( I , J ) ) 

10  CONTINUE 
RETURN 

ENTRY  MUTUR(II) 

A*************************************************************** 


BALDWIN  -  LOMAX  TURBULENCE  MODEL 
I  =  I  I 

FYMAX=0 . 0 
YMAX=0 . 0 
UDIF=0. 

YVERT( JL)=0. 0 

TAUW=ZMU( JL)*ABS(ETAY( I, JL)*(U(I, JL)-U( I, JL-1) ) 

>  -ETAX(I, JL)*(V( I, JL)-V( I, JL-1) ) ) 

CYP=SQRT ( RHO ( I , JL ) *TAUW ) /ZMU ( JL ) 

DO  20  KK=2,JL1 
K=JL+1-KK 

YVER=YVERT ( K+ 1 )  + 1 . 0/SQRT ( ETAX ( I , K ) *  *  2 +ETAY ( I , K ) *  *  2 ) 
OMG=ABS(ETAY(I,K)*(U(I,K+l)-U(I,K-l) )*.5 

>  +SAIY(I,K)*(U(I,K)-U(I-1,K)) 

>  -ETAX(I,K)*(V( I,K+1)-V( I,K-1) )*.5 

>  -SAIX(I,K)*(V(I,K)-V(I-1,K))) 

YPLUS=CYP*YVER 

CEXP=YPLUS/AP 

IF(CEXP.GT. 500. )  CEXP=500. 

TURLEN=VKCON*YVER* ( 1 . 00-EXP ( -CEXP ) ) 

ZMUI{K)=RHO( I,K)*OMG*TURLEN**2 
F Y=TURLEN/VKCON*  OMG 
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UTOTAL=SQRT(U( I,K)**2+V(I,K)**2) 

IF(UTOTAL.GE.UDIF)  UDIF=UTOTAL 
IF(FY. LT. FYMAX)  GO  TO  20 
FYMAX=FY 
YMAX=YVER 
20  YVERT(K)=YVER 

* 

VXDIF=UDIF 
FWAKE 1 =YMAX * FYMAX 
FWAKE2=CWK*YMAX*VXDI F* *2/FYMAX 
FWAKE=AMIN1 ( FWAKEl , FWAKE2 ) 

* 

DO  30  KK=2,  JLl 
K=JL+1-KK 

FKLEB= ( CKLEB  *  YVERT ( K ) /YMAX ) *  *  6 
FKLEB=1 . /( 1 • 0+5 . 5*FKLEB) 

ZMUO=XK*  CCP  *  RHO ( I , K ) *  FWAKE  *  FKLEB 
IF(ZMUI (K) .GT.ZMUO)  THEN 
ZMUTUR=ZMUO 
ELSE 

ZMUTUR=ZMUI (K) 

END  IF 

ZMUT ( K ) =ZMUTUR 

ZMU ( K ) =ZMU ( K ) +ZMUTUR 

WRITE  (77,500)  K, Y( I , K) , YVERT( K) , U( I , K) , ZMUI (K) , ZMUO, ZMU( K) 
500  FORMAT(2X, 13, 6(2X,D13 . 6) ) 

30  CONTINUE 

* 

ZMUT( 1 )=0. 

ZMUT( JL)=0. 

RETURN 

**************************************************************** 
ENTRY  KLAM(II) 

**************************************************************** 
I  =  I  I 

DO  40  J=1,JL 

ZK( J)=FZK(RHO(I, J),E(I,  J) ) 

40  CONTINUE 
RETURN 

ENTRY  KTUR(II) 

irie-kicic-kieir-k'kiririciritit'k’kit'k'k'k'k'k'kic'k'k’k'k^ie'k'k'k'kicic’k'k'k’k'k'k’k'k’k'k'k'k'k’k’k'k'k’k'k'k'k'k'k'kic'k 

i  =  i  I 

DO  50  J=1,JL 

CPT=RG/AMW(I, J)+E(I, J)/T(I, J) 

ZKT^CPT/PRNT*  ZMUT ( J ) 

ZK( J)=ZK( J)+ZKT 
50  CONTINUE 
RETURN 
END 

SUBROUTINE  MCONST 

**************************************************************** 

★ 

*  SUBROUTINE  FOR  CALCULATING  METRIC  TERMS  AT  THE  MIDPOINT 

*  (I,J+l/2),  (FOR  THE  VISCOUS  VECTOR  DMVS/DETA) 
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4  2  2 

Al( I , J)=(-ETA  +ETA  ) 
3  X  Y 


A2( I, J)=-ETA  *ETA 
3  X  Y 

2  4  2 

A3(I,J)=(ETA  +-ETA  ) 
X  3  Y 

2  2 

A4(I,J)=(ETA  +ETA  ) 

X  Y 


★ 

* 

★ 

* 

★ 

* 

★ 

■k 
* 

* 

* 
k 
k 
k 
k 
k 
k 
k 

kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

PARAMETER  ( IZ=60 , J2=40 ) 

COMMON  /VECTOR/  DQ( IZ, JZ, 4) ,Q( IZ, JZ, 4) . F{ IZ, JZ, 4) , 

>  G(IZ,JZ,4),  P(IZ, JZ),T(IZ,JZ),E(IZ, JZ),AMW(IZ,JZ), 

>  U(IZ, JZ) ,V(IZ, JZ) ,UN(IZ, JZ),VN(IZ, JZ), 

>  ZMIT(  JZ)  ,  ZMUT(  JZ)  ,  ZK(  JZ) 

COMMON  /COORD/  SAIX( IZ , JZ ) , SAI Y( IZ, JZ ) , ETAX( IZ , JZ ) , 

>  ETAY(IZ, JZ) ,RJ(IZ, JZ),X(IZ, JZ),Y(IZ, JZ) , 

>  DELTAU(IZ, JZ) ,A1(IZ, JZ),A2(IZ, JZ) ,A3(IZ, JZ), 

>  A4(IZ,JZ) 

COMMON  /CONS/  EXI , EYI , THETA, CFL, CFLl , OMEGAX, OMEGAY, AIN, AEX, 

>  RL , RG , AMWO , GAMMAO , REN , PRN , PRNT , TREF , ZMUO , OMEGA , 

>  PO,TO,TWALL,PB, SUM(4) 

COMMON  /INTEG/  IL, JL, ILl, JL1,NBEG,NEND,NADV,N0RD, ITIME, 

>  IVISC, IWALL, IWRT 

DIMENSION  RHO(IZ, JZ) ,RHOU(IZ. JZ) ,RHOV(IZ, JZ) ,E0( IZ, JZ) 

EQUIVALENCE  ( Q( 1 , 1 , 1 ) , RHO( 1 , 1 ) ) , (Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(1,1,3),RH0V(1,1)), (Q(1,1,4),E0(1,1)) 

DATA  FD3,OD3  /I . 333333333333 , 0 . 333333333333 / 

kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 


DO  10  1=2, IL 
DO  10  J=1,JL1 
IF(I.EQ.IL)  THEN 

XSAI=0.5*(X(I, J)+X(I, J+1)-X(I-1, J)-X( I-l, J+1) ) 
YSAI=0.5*(Y(I, J)+Y(I, J+1)-Y(I-1, J)-Y(I-1, J+1) ) 

ELSE 

YSAI=0.25*(Y( I+l, J+1)+Y(I+1, J)-Y(I-1, J+1)-Y(I-1, J) ) 
XSAI=0.25*{X( I+l, J+l)+X( I+l, J)-X(I-1, J+l)-X( I-l, J) ) 
END  IF 

YETA=Y(I, J+1)-Y(I, J) 

XETA=X( I, J+l)-X{ I, J) 

RJJ=1 . /(XSAI*YETA-XETA*YSAI ) 

A1(I, J)=RJJ*RJJ*(FD3*YSAI**2+XSAI**2) 

A2( I, J)=-RJJ*RJJ*0D3*XSAI*YSAI 

A3( I,  J)=RJJ*RJJ*(YSAI**2  +  FD3*XSAI**2) 

A4( I , J)=RJJ*RJJ*(XSAI**2+YSAI**2) 

10  CONTINUE 
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RETURN 

END 

SUBROUTINE  AVERAGE( lA, I ROE , CXM, CYM, RHOM, UM, VM, EOM, PM, UCNM, 

>  EM,TM, AMWM, I, J) 

iricic'k'k'kif'k'k-k-kir'k-k'k'k-k-k'k'k'k'k'k'k’k'k'k'k'k’k'k'k'k'k'k'k’k’kieie'kic'k'k'k'k'k-kicit'kic’k'k'k’k'k'k'k'kirit'kie 


*  SUBROUTINE  FOR  AVERAGING  FLOW  PROPERTIES 

* 

*  IF  IA=1,  AVERAGING  OF  Q  FOR  A  MATRIX 

*  IF  IA=2,  AVERAGING  OF  Q  FOR  B  MATRIX 

*  IF  IROE-0,  MEAN  VALUE  AVERAGING 

*  IF  IROE=l,  ROE  AVERAGING 

* 

**************************************************************** 
PARAMETER  ( IZ=60, JZ=40 ) 

COMMON  /VECTOR/  DQ ( IZ , JZ , 4 ) , Q ( IZ , JZ, 4 ) , F ( IZ, JZ , 4 ) , 

>  G(IZ,JZ,4),  P(IZ, JZ),T(IZ,JZ),E(IZ, JZ),AMW(IZ, JZ), 

>  U( IZ, JZ) , V( IZ, JZ) ,UN( IZ, JZ) ,VN( IZ, JZ) , 

>  ZMU(JZ),ZMUT(JZ),ZK(JZ) 

COMMON  /COORD/  SAIX( IZ , JZ ) , SAIY( IZ, JZ ) , ETAX( IZ , JZ ) , 

>  ETAY( IZ, JZ) ,RJ(IZ, JZ) ,X(IZ, JZ),Y(IZ, JZ) , 

>  DELTAU(IZ, JZ),A1(IZ, JZ),A2(IZ, JZ),A3(IZ, JZ), 

>  A4(IZ,JZ) 

COMMON  /CONS/  EXI , EYI , THKTA, CFL, CFLl , OMEGAX, OMEGAY, AIN, AEX, 

>  RL , RG , AMWO , GAMMAO , REN , PRN , PRNT , TREF , ZMUO , OMEGA , 

>  P0,T0,TWALL,PB, SUM(4) 

DIMENSION  RHO(IZ, JZ),RHOU(IZ, JZ),RHOV(IZ, JZ),E0(IZ, JZ) 
EQUIVALENCE  ( Q ( 1 , 1 , 1 ) , RHO ( 1 , 1 ) ) , (Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 
(Q(l,l,3),RHOV(l,l)), (Q(1,1,4),E0(1,1)) 

'kit'k'k'kitiri^-k-k'k-k-k-k-k'k-k-k'k'k'k'k'k'kit'kiK-k’kit'k'k'k'k'k-k'k'k'k'k'k'kic'k'k'kit'k'kit'k'k'k'k'k'k'k'k'k'k'klc'k'k 

IROE=l 

IF(IA.EQ.l)  THEN 
11  =  1 
J1=J 
12=1+1 
J2=J 

CXM=0.5*(SAIX(I1, J1)+SAIX(I2, J2) ) 

CYM=0. 5*(SAIY( II, J1)+SAIY( 12, J2) ) 

END  IF 

IF(IA.EQ.2)  THEN 
11  =  1 
J1=J 
12  =  1 
J2=J+1 

CXM=0 . 5  * ( ETAX ( 1 1 , J1 ) +ETAX ( 1 2 , J2 ) ) 

CYM=0 . 5* ( ETAY( I 1 , J1 ) +ETAY( 12 , J2 ) ) 

END  IF 

IF( IROE.EQ.O)  THEN 

RHOM=0.5*(RHO( II, Jl)+RHO(I2, J2) ) 

UM=0.5*(U( II, Jl)+U( 12, J2) ) 

VM=0. 5*(V( II, J1)+V(I2, J2) ) 

E0M=0 . 5* ( EO ( I 1 , J1 ) +E0 ( I 2 , J2 ) ) 

PM=0.5*(P(I1, J1)+P(I2, J2) ) 

IF(IA.EQ. 1)  UCNM=0.5*(UN(I1, J1)+UN(I2, J2) ) 

IF( IA.EQ.2)  UCNM=0.5*(VN(I1, J1)+VN{I2, J2) ) 
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UCNM=CXM*UM+CYM*VM 
EM=E0M/RHOM-0 . 5* (UM**2  +VM**2 ) 

TM=FT(RHOM,EM) 

AMWM=FAMW ( RHOM , TM ) 

END  IF 

IF( IROE.EQ. 1)  THEN 

SQRH01=SQRT(RH0( II, Jl) ) 

SQRH02=SQRT(RH0(I2, J2) ) 

DENOM=SQRHO 1  +  SQRH02 

RHOM= ( RHO ( 1 1 , J 1 ) *  SQRHO 1  +  RHO ( 1 2 , J2 ) *  SQRH02 ) /DENOM 
UM=(U( II, J1)*SQRH01+U( 12, J2)*SQRH02 ) /DENOM 
VM= ( V ( 1 1 , J 1 ) *  SQRHO 1 + V ( 1 2 , J2 ) *  SQRH02 ) /DENOM 
HT1=(E0(I1, Jl)+P( II, Jl) )/RHO( II, Jl) 

HT2=(E0(I2, J2)+P( 12, J2) )/RHO(I2, J2) 
HTM-^(HT1*SQRH01+HT2*SQRH02  ) /DENOM 

*  ARITHMETIC  AVERAGING  OF  "REAL  GAS  GAMMA" 

Gl=l. +(RG/AMW(I1, Jl) )/(E(Il, J1)/T(I1, Jl) ) 
G2=1.+(RG/AMW(I2, J2) )/(E(I2, J2)/T(I2, J2) ) 

GM=0.5*(G1+G2) 

PM=(GM-1. )/GM*(RHOM*HTM-0.5*RHOM*(UM**2+VM**2) ) 

EOM=RHOM*HTM-PM 

UCNM=CXM*UM+CYM*VM 

EM=EOM/RHOM- 0 . 5  * ( UM*  *  2  + VM*  *2 ) 

TM=FT(RHOM,EM) 

AMWM=FAMW ( RHOM , TM ) 

END  IF 
RETURN 
END 

SUBROUTINE  JCBCL 

'k'k'k-k'k’kic’k'k-k’k'k'k-k'k'k'k'k’kie-k'k'k'k'k'k'k'k’k'k'kic'kieic'kicie'kic'k'k'k'k'k'k-k'kieic'k'k'kic'kic'kic'kic'k'k'k'k 

* 

*  SUBROUTINE  FOR  JACOB IANS  CALCULATIONS 

* 

iticic'k^ic'k'fr-k'k'k'k’k'k'k'k'k'k-kit'kieie’k'k'k'k-k'k'k-k'k'k-k'k'kicicic'k'k'kie'k'k'k'k'k'kic'k'k'k'k’k'k'kic'k'k'kic’k'k 

PARAMETER  ( IZ=60, JZ=40 ) 

COMMON  /VECTOR/  DQ( IZ , JZ , 4 ) , Q( IZ, JZ, 4 ) , F( IZ, JZ, 4 ) , 

>  G(IZ,JZ,4),  P(IZ, JZ),T(IZ, JZ),E(IZ, JZ),AMW(IZ, JZ), 

>  U(IZ, JZ),V(IZ, JZ),UN(IZ, JZ),VN(IZ, JZ), 

>  ZMU(JZ),ZMUT(JZ),ZK(JZ) 

COMMON  /COORD/  SAIX( IZ, JZ) , SAIY( IZ, JZ) , ETAX( IZ, JZ) , 

>  ETAY(IZ, JZ) ,RJ(IZ, JZ) ,X{IZ, JZ), Y(IZ, JZ) , 

>  DELTAU(IZ, JZ),A1(IZ, JZ),A2(IZ, JZ),A3(IZ, JZ) , 

>  A4(IZ,JZ) 

COMMON  /CONS/  EXI , EYI , THETA, CFL, CFLl , OMEGAX, OMEGAY, AIN, AEX, 

>  RL , RG , AMWO , GAMMAO , REN , PRN , PRNT , TREF , ZMUO , OMEGA , 

>  P0,T0,TWALL,PB,SUM(4) 

COMMON  /INTEG/  I L, JL, ILl , JLl , NBEG, NEND, NADV, NORD, ITIME , 

>  IVISC, IWALL, IWRT 

DIMENSION  RHO(IZ, JZ) ,RHOU(IZ, JZ),RHOV(IZ, JZ) ,E0( IZ, JZ) 
EQUIVALENCE  ( Q( 1 , 1 , 1 ) , RHO( 1 ,1)),(Q(1,1,2), RHOU( 1,1)), 

>  (Q(1,1,3),RH0V(1,1)),(Q(1.1,4),E0(1,1)) 
DIMENSION  A(4,4) ,B(4,4) ,C(4,4) ,AA(4,4) ,BB(4,4) ,DIAG(4) , 

>  D(4,4) 

**************************************************************** 
ENTRY  JCBABdA,  IMID,A,  I,  J) 
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**************************************************************** 


* 

JACOBIAN 

A  OR  B  MATRIX  CALCULATIONS 

* 

* 

A=DE/DQ, 

B=DF/DQ 

•k 

IF  IA-=1, 

ACAP  MATRIX 

k 

k 

IF  IA=2, 

BCAP  MATRIX 

IF( ( lA.EQ. 1 . AND. IMID.EQ.O) .OR. 

>  ( lA.EQ. 1 . AND. IMID.EQ. 1 . AND. I -EQ. IL) )  THEN 
CX=SAIX( I , J) 

CY=SAIY( I , J) 

QRHO=RHO ( I , J ) 

QU=U(I, J) 

QV=V(I, J) 

QE0=E0(I, J) 

QP=P(I, J) 

QCN=UN( I, J) 

QE=E(I, J) 

QT=T(I,J) 

QAMW=AMW(I, J) 

END  IF 

IF( (IA.EQ.2.AND. IMID.EQ.O) .OR. 

>  (IA.EQ.2.AND.IMID.EQ.1.AND.J.EQ.JL))  THEN 
CX=ETAX( I , J) 

CY=ETAY(I, J) 

QRHO=RHO ( I , J ) 

QU=U(I, J) 

QV=V(I, J) 

QEO=EO( I , J) 

QP=P(I, J) 

QCN=VN( I , J) 

QE=E(I, J) 

QT=T(I,J) 

QAMW=AMW( I , J) 

END  IF 

IF( lA.EQ. 1. AND. IMID . EQ . 1 . AND . I .NE. IL)  THEN 

CALL  AVERAGE ( I A, IROE , CX, CY, QRHO, QU, QV, QEO , QP , QCN, 

>  QE,QT,QAMW, I, J) 

END  IF 

IF( lA.EQ. 2 .AND. IMID.EQ. 1 . AND . J . NE . JL)  THEN 

CALL  AVERAGE(IA, IROE , CX, CY, QRHO, QU, QV, QEO, QP , QCN, 

>  QE,QT,QAMW, I , J) 

END  IF 

AR=FAR ( QP , QRHO , QT , QE , QAMW ) 

AE=FAE ( QP , QRHO , QT , QE , QAMW ) 

AER=AE/QRHO 

DPDR=AR+AER* ( -QEO/QRHO+ (QU**2+QV**2 ) ) 

DPDU=-AER*QU 

DPDV=-AER*QV 

DPDE=AER 

A(l, 1)=0.0 

A(1,2)=CX 

A(1,3)=CY 
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A(l,4)=0.0 

A ( 2 , 1 ) =-QU*QCN+CX*DPDR 
A ( 2 , 2 ) =QCN+CX* ( QU+DPDU ) 

A ( 2 , 3 ) =CY*QU+CX*DPDV 
A(2, 4)=CX*DPDE 
A(3, 1)=-QV*QCN+CY*DPDR 
A ( 3 , 2 ) =CX*QV+CY*DPDU 
A ( 3 , 3 ) =QCN+CY* ( QV+DPDV ) 

A{3,4)=CY*DPDE 

A(4, 1)=QCN*(DPDR-(QEO+QP)/QRHO) 

A ( 4 , 2 ) =QCN*DPDU+CX* ( QEO+QP ) /QRHO 
A  4 , 3 ) =QCN*DPDV+CY* ( QEO+QP ) /QRHO 
A(4,4)=QCN*(1.+DPDE) 

RETURN 

**************************************************************** 
ENTRY  JCBABPM( lA, IB, IMID, A, I , J) 

**************************************************************** 


•k 

k 

SPLITTED 

JACOBIAN  A-PLUS, 

A-MINUS,  B-PLUS,  OR 

B-MINUS 

k 

+  -1  - 

1  + 

-  -1  -1 

- 

k 

k 

A  =T  *P 

*( LAMBDA)  *P*T, 

A  =T  *P  *( LAMBDA) 

*'p*'£ 

k 

+  -1  - 

1  + 

-  -1  -1 

- 

k 

k 

B  =T  *P 

*( LAMBDA)  *P*T, 

B  =T  *P  *( LAMBDA) 

*'p*’J^ 

*  IF  IA=1  IB=1  -  A-PLUS  MATRIX 

*  IF  IA=1  IB=2  -  A-MINUS  MATRIX 

*  IF  IA=2  IB=1  -  B-PLUS  MATRIX 

*  IF  IA=2  IB=2  -  B-MINUS  MATRIX 

*  IF  IMID=0  -  JACOBIAN  CALCULATED  IN  POINT  (I,J) 

*  IF  IMID=1  IA=1  -  JACOBIAN  CALCULATED  IN  POINT  ( 1+1/2, J) 

*  IF  IMID=1  IA=2  -  JACOBIAN  CALCULATED  IN  POINT  (I,J+l/2) 

* 

•k-k-k'k'k-k'k'k'k^'k'k^’k’k'k'k'k-k'k'k'k'k'k-k'k'k'k'k'fe’k’k'k'k'k’k'k'k'k-k'ic'k^'ft'k'k-k'k'k’k'k'k'k'k'k'k'kic'k'k'k^'k'k 

IF( (lA.EQ. l.AND. IMID.EQ.O) ,OR. 

>  (lA.EQ.l.AND.IMID.EQ.l.AND.I.EQ.IL))  THEN 
CX=SAIX(I, J) 

CY=SAIY( I, J) 

QRHO=RHO ( I , J ) 

QU=U(I, J) 

QV-V(I, J) 

QE0=E0(I, J) 

QP=P(I, J) 

QCN=UN(I, J) 

QE=E(I, J) 

QT=T(I, J) 

QAMW=AMW(I, J) 

END  IF 

IF{ ( lA.EQ. 2 .AND. IMID.EQ.O) .OR. 

>  ( IA.EQ.2 . AND. IMID.EQ. 1 . AND. J.EQ. JL) )  THEN 
CX=ETAX(I, J) 

CY=ETAY(I, J) 

QRHO=RHO(I,  J) 

QU=U(I,J) 

QV=V(I, J) 
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QE0=E0( I , J) 

QF=P(I, J) 
gCN=VN( I , J) 

QF-E( I, J) 

QT-T( I, J) 

QAMW-AMW( I , J) 

END  IF 

IF( lA.Ey . 1 .AND. IMID.EQ. 1 . AND . I .NE. IL)  THEN 

CALL  AVERAGE ( I A , I ROE , CX , CY , QRHO , QU , QV , QEO , QP , QCN , 

>  QE,QT,QAMW,I,J) 

END  IF 

IF( IA.EQ.2 .AND. IMID.EQ. 1 . AND . J . NE . JL)  THEN 

C A LL  AVERAGE ( I A , I ROE , CX , C Y , QRHO , QU , QV , QEO , QP , QCN , 

>  QE,QT,QAMW, I, J) 

END  IF 

C0=SQRT ( FC02 { QP , QRHO , QT , QE , QAMW ) ) 

CQ=SQRT(CX**2+CY**2 ) 

CQCO=CQ*CO 
EIG4=QCN-CQC0 
IF(IB.EQ.l)  THEN 
DIAG(1)=QCN 
DIAG(2)=QCN 
DIAG(3  =QCN+CQCO 
DIAG(4)=0. 

IF(EIG4.GE.0.0)  DIAG{4)=EIG4 
END  IF 

I F ( I B . EQ . 2 )  THEN 
DIAG( 1)=0. 

DIAG(2 )=0. 

DIAG(3)=0. 

DIAG(4)=0. 

IF(EIG4. LT.0.0)  DIAG(4)=EIG4 
END  IF 

CALL  TMPM( lA, IMID, AA, I , J) 

DO  30  11=1,4 
DO  30  JJ=1,4 

BB( 1 1 ,  JJ)=DIAG( II )*AA( 1 1 , JJ) 

30  CONTINUE 

CALL  PPTP( lA, IMID, AA, I , J) 

CALL  MMM(4, AA,BB, A) 

RETURN 

'k'kieieicicii^-k'k-k-k-kif-k-k-kit-k-k'k'k-k-k'kirie-k'k'k'k-k'k'k'k'k'k'k'k-k'k'k'k'kie'k’kif'k'k'k'k'k'kic’k'kit-k'k’k'k-k'k’k 

ENTRY  JCBD(D,I,J) 

'k'k'k’k'k'k'k-k'k-k-kk-k-k-k^'k'k'k'k'kic-k'kie-k'k-k^'k’k'tr'k'kieic'k'kieic'k'k'kic-k'k'k'kie'k'k-k'k'k'k'k'kie'k'k'k'k'k'k 

* 

*  SOURCE  TERM  JACOBIAN  MATRIX,  D=DHVDQ 

* 

*  H(1)=0. 

*  H(2)=0. 

*  H(3 )={P-4./3 . *MU*V/Y)/J 

*  H(4)=0. 

•k 

**************************************************************** 
CALL  SZER0(4,D) 

IF( IVISC.EQ.O)  THEN 
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ZMU{ J)=0. 

DMUDR=0 . 

DMUDU=0 . 

DMUDV=0 . 

DMUDE-0 . 

ELSE 

CR^FDMUDRE ( RHO (I,J),E(I,J)) 

CE=FDMUDER(RHO( I , J) , E( I , J) ) 

CER=CE/RHO( I , J) 

DMUDR=CR+CER*(-EO(I, J)/RHO(I, J)+(U(I, J)**2+V(I, J)**2) ) 
DMUDU=-CER*U( I , J) 

DMUDV=-CER*V( I ,  J) 

DMUDE=CER 
END  IF 

AR=FAR(P(I, J),RHO(I, J),T(I, J),E(I, J),AmW(I, J) ) 

AE= F AE ( P ( I , J ) , RHO (I,J),T(I,J),E(I,J), AMW ( I , J ) ) 

AER=AE/RHO( I, J) 

DPDR=AR+ AER* ( -EO ( I , J ) /RHO (I,J)+(U(I,J)**2+V(I,J)**2)) 
DPDU=-AER*U(I, J) 

DPDV=-AER*V( I , J) 

DPDE^AER 

RY=4./3 ./Y( I . J)**2 
D(3, 1)=DPDR/Y(I, J) 

>  +IVISC*(-V(I,  J)*DMlJDR+ZMU(J)*V(I,  J)/RHO(I,  J)  )*RY 
D(3,2)=DPDU/Y(I, J) 

>  +IVISC*(-V( I, J)*DMUDU)*RY 
D(3,3)=DPDV/Y(I, J) 

>  +IVISC*(-V{I, J)*DMUDV-ZMU(J)/RHO(I, J) )*RY 
D(3,4)=DPDE/Y( I, J) 

>  +IVISC*(-V(I, J)*DMUDE)*RY 
RETURN 

'k'kie'k'k'k’k’k-k'kie'k'k-k'k’k'k'fc’k'kir'k'k-kie'k'k'k-k-k'k'k'k'k'k'k'kit'k'k’k'k'k'k'k’k'k'k'k’k-k-k'k'k-k-k'k'k'k'k'k'k'k'k 

ENTRY  JCBMVS(A,B,C, I, J) 

**************************************************************** 

* 

*  VISCOUS  JACOBIAN  MATRIX,  MVS=-D{DSVS' /DETA+H' ' )/DQ 

★ 

*  H(1)=0. 

* 

*  12 

*  H(2)=-*(--*ETA  *D(MU*V)/DETA) 

*  J  3  X 

* 

*12  2 

*  H(3 )=-*(-*ETA  *MU*DU/DETA--*ETA  *V*D(MU)/DETA) 

*  J  3  X  3  Y 

* 

*12  2 

*  H(4)=-*(--*ETA  *D(MU*U*V)/DETA--*ETA  *D(MU*V*V)/DETA) 

*  J  3  X  3  Y 

* 

•k'k'k-kieic'k'k'k'k-kiric'k'k-kicic-kic-k'kicitie'kic'k-k'k'k'k-k'k'k'k'k'k'k'kic’kit'k'k'k'kit'k’kic'k-kic'^'k'k^ie'A'k'k'kic 

jpi=j+i 

JM1=J-1 

YJPl  =  Y(I, JP1)/RJ(I, JPl) 
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YJP 

YJ 

YJM 

YJMl 

EXJ 

EYJ 

RHOP 

RHOM 

UP 

UM 

VP 

VM 

EP 

EM 

ORPl 

OR 

ORMl 

UORPl 

UOR 

UORMl 

VORPl 

VOR 

VORMl 

U2P1 

U2P 

U2 

U2M 

U2M1 

V2P1 

V2P 

V2 

V2M 

V2M1 

UVPl 

UV 

UVMl 

U20RP1 

U20R 

U20RM1 

V20RP1 

V20R 

V20RM1 

UVORPl 

UVOR 

UVORMl 

ZMIJP 

ZMUM 

YJZMUP 

YJZMUM 

ZKP 

ZKM 

YJZKP 

YJZKM 

EOORPl 

EOORP 


0.5*(Y( I, J)/RJ(I, J)+Y(I, JP1)/RJ(I, JPl) ) 

Y(I, J)/RJ(I, J) 

0.5*(Y(I, J)/RJ(I, J)+Y(I, JM1)/RJ(I, JMl) ) 

Y( I, JM1)/RJ(I, JMl) 

1 ./3 . *ETAX( I , J)/RJ( I , J) 

1 ./3 - *ETAY( I , J)/RJ( I , J) 

0.5*(RHO{I, J)+RHO(I, JPl)) 

0 . 5  * ( RHO ( I , J ) +RHO ( I , JMl ) ) 

0.5*(U(I, J)+U(I, JPl)) 

0.5*(U(I, J)+U(I,JM1)) 

0.5*(V(I, J)+V(I, JPl) ) 

0.5*(V(I, J)+V(I, JMl)) 

0.5*(E(I, J)+E(I, JPl)) 

0.5*(E(I, J)+E(I, JMl)) 
l./RHO(I, JPl) 

1 ./RHO( I , J) 
l./RHO(I, JMl) 

U(I, JP1)/RH0(I. JPl) 

U ( I , J ) /RHO ( I , J ) 

U(I, JMl) /RHO (I, JMl) 

V(I, JP1)/RH0(I, JPl) 

V(I, J)/RHO(I, J) 

V( I , JMl )/RHO( I , JMl ) 

U( I , JPl )**2 

(0.5*(U(I, J)+U(I, JP1)))**2 
U( I , J)**2 

(0.5*(U(I, J)+U(I, JM1)))**2 
U( I, JM1)**2 
V{ I, JPl )**2 

(0.5*(V(I,  J)+V(I,  JP1)))"^*2 
V( I , J)**2 

(0.5*(V(I, J)+V(I,JM1)))**2 

V( I, JMl)* *2 

U(I, JP1)*V(I, JPl) 

U(I, J)*V(I, J) 

U(I, JM1)*V(I, JMl) 

U2P1*0RP1 

U2*OR 

U2M1*0RM1 

V2P1*0RP1 

V2*OR 

V2M1*0RM1 

UVP1*0RP1 

UV*OR 

UVMl* ORMl 

0. 5*(ZMU( J)+ZMU( JPl) ) 

0. 5*(ZMU( J)+ZMU( JMl) ) 

YJP*ZMUP 
YJM* ZMUM 

0. 5*(ZK( J)+ZK( JPl) ) 

0. 5*(ZK( J)+ZK( JMl) ) 

YJP*ZKP 

YJM*ZKM 

E0( I,  TP1)/RH0(I, JPl) 

0.5*(E0(I, J)/RHO(I, J)+E0(I, JP1)/RH0(I, JPl) ) 
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EOOR  =  EO(I, J)/RHO(I, J) 

EOORM  =  0.5*(E0(I, J)/RHO(I,J)+EO(I,JM1)/RHO(1,JM1)) 
EOORMl  -  E0( I , JMl )/RHO( I , JMl ) 

BR-FDTDRE ( RHO ( I , JPl ) , E { I , JPl ) ) 

BE^FDTDER(RHO( I , JPl) ,E( I , JPl) ) 

BER=BE/RHO(I, JPl) 

DTDRP1=BR+BER*(-EOORP1+(U2P1+V2P1) ) 

DTDUP1=-BER*U( I , JPl ) 

DTDVP1=-BER*V( I , JPl ) 

DTDEP1=BER 

BR=FDTDRE ( RHO (I,J),E{I,J)) 

BE=FDTDER(RHO( I , J) ,E( I , J) ) 

BER=BE/RHO( I , J) 

DTDR=BR+BER* ( -E0OR+ (U2+V2 ) ) 

DTDU=-BER*U( I , J) 

DTDV=-BER*V( I , J) 

DTDE=BER 

BR=FDTDRE ( RHO ( I , JMl ) , E ( I , JMl ) ) 

BE=FDTDER { RHO ( I , JMl ) , E ( I , JMl ) ) 

BER=BE/RHO( I, JMl) 

DTDRM1=BR+BER* ( -EOORMl + ( U2M1+V2M1 ) ) 

DTPUM1=-BER*U( I , JMl ) 

DTDVM1=-BER*V( I , JMl ) 

DTDEM1=BER 

CR=FDMUDRE(RHO(I, JPl) ,E(I, JPl) ) 

CE=FDMUDER(RHO( I , JPl ) , E( I , JPl ) ) 

CER=CE/RHO( I , JPl ) 

DMUDRP1=CR+CER*(-EOORP1+(U2P1+V2P1) ) 

DMUDUP1=-CER*U( I , JPl ) 

DMUDVP1=-CER*V( I , JPl ) 

DMUDEP1=CER 
CR=FDMUDRE ( RHOP , EP ) 

CE=FDMUDER ( RHOP , EP ) 

CER=CE/RHOP 

DMUDRP=CR+CER* ( -EOORP+ (U2P+V2P) ) 

DMUDUP^-CER*UP 

DMUDVP=-CER*VP 

DMUDEP^CER 

CR=FDMUDRE ( RHO (I,J),E(I,J)) 

CE-FDMUDER { RHO (I,J),E(I,J)) 

CER=CE/RHO( I, J) 

DMUDR^CR+CER*(-EOOR+(U2+V2) ) 

DMUDU=-CER*U( I, J) 

DMUDV=-CER*V( I , J) 

DMUDE=CER 

CR=FDMUDRE ( RHOM , EM ) 

CE=FDMUDER ( RHOM , EM ) 

CER=CE/RHOM 

DMUDRM=CR+CER* ( -EOORM+ ( U2M+V2M ) ) 

DMUDUM=-CER*UM 

DMUDVM=-CER*VM 

DMUDEM=CER 

CR^FDMUDRE ( RHO { I , JMl ) , E ( I , JMl ) ) 
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CE=FDMUDER(RHO( I , JMl ) , E( I , JMl ) ) 

CER=CE/RHO( I , JMl ) 

DMUDRM1=CR+CER* ( -EOORMl + ( U2M1+V2M1 ) ) 

DMUDUM1=-CER*U( I , JMl ) 

DMUDVM1=^-CER*V(  I  ,  JMl ) 

DMUDEM1=^CER 

DR=FDKDRE ( RKOP , EP ) 

DE^FDKDER ( RHOP , EP ) 

DER-DE/RHOP 

DKDRP=DR+DER* ( -EOORP+ ( U2P + V2P ) ) 

DKDUP=-DER*UP 
DKDVP=^-DER*VP 
DKDEP=DER 
DR^FDKDRE ( RHOM , EM ) 

DE=FDKDER ( RHOM , EM ) 

DER^DE/RHOM 

DKDRM=DR+DER* ( -EOORM+ ( U2M+ V2M ) ) 

DKDUM^-DER*UM 

DKDVM=-DER*VM 

DKDEM=DER 

COMPUTE  -M-- (DSVS' /DQ)/DETA 

IF( JMl.EQ. 1)  THEN 
CALL  SZER0(4,A) 

ELSE 

A(l, l)-0. 

A( 1,2)=0. 

A(  1 , 3  )-=0  . 

A(l,4)=0. 

A ( 2 , 1 ) =-DMUDRM* ( A1 ( I , JMl ) *U( I , JMl ) +A2 ( I , JMl ) * V ( I , JMl ) ) 

>  + YJZMUM* ( A1 ( I , JMl ) *U0RM1+A2{ I , JMl ) *V0RM1 )/YJMl 
A ( 2 , 2 ) =-DMUDUM* ( A1 ( I , JMl ) *U( I , JMl ) +A2 ( I , JMl ) *V( I , JMl ) ) 

>  -YJZMIJM*A1(I,  JM1)*0RM1/YJM1 

A ( 2 , 3 ) =-DMUDVM* ( A1 ( I , JMl ) *U( I , JMl ) +A2 ( I , JMl ) *V( I , JMl ) ) 

>  -YJZMUM*A2 ( I , JMl ) *0RM1/YJM1 

A ( 2 , 4 ) =-DMUDEM* ( A1 ( I , JMl ) *U ( I , JMl ) +A2 ( I , JMl ) *V( I , JMl ) ) 
A ( 3 , 1 ) ^-DMUDRM* ( A3 ( I , JMl ) *V ( I , JMl ) +A2 ( I , JMl ) *U ( I , JMl ) ) 

>  -t-YJZMUM^lAJi  I,  JM1)*V0RM1+A2(I,  JM1)*U0RM1)/YJM1 
A  (  3 , 2  )  -=-DMUDUM*  {  A3  (  I  ,  JMl )  * V ( I ,  JMl )  +A2  (  I ,  JMl )  *U ( I ,  JMl )  ) 

>  -YJZMUM*A2( I , JM1)*0RM1/YJM1 

A ( 3 , 3 ) =-DMUDVM* ( A3 ( I , JMl ) * V( I , JMl ) +A2 ( I , JMl ) *U( I , JMl ) ) 

>  -YJZMUM*A3(I, JM1)*0RM1/YJM1 

A  (  3 , 4  )  =-DMUDEM*  ( A3  (  I  ,  JMl )  *V(  I ,  JMl )  +A2  (  I  ,  JMl )  *'J  (  I ,  JMl )  ) 
A  (  4,  1  )  =-DMUDRM*  (  0 . 5*A1  (  I  ,  JMl )  *U2M1+A2  (  I  ,  JMl ) 

>  +0. 5*A3( I , JM1)*V2M1) 

>  +YJZMUM* ( A1 ( I , JMl ) *U20RMl+2 . 0*A2 ( I , JMl ) *UV0RM1 

>  +A3( I , JMl )*V20RM1)/YJM1 

>  -DKDRM*A4(I, JM1)*T(I,JM1) 

>  -YJZKM*-A4{  I,  JM1)*DTDRM1/YJM1 

A( 4, 2 )=-DMUDUM* (0. 5*A1 ( I , JMl ) *U2M1+A2 ( I , JMl ) *UVM1 

>  +0. 5*A3( I , JM1)*V2M1) 

>  -YJZMUM* ( Al( I , JMl )*U0RM1+A2( I , JMl ) *V0RM1 ) /YJMl 
-DKDUM*A4( I , JMl ) *T( I , JMl ) 
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>  -YJZKM*A4( I , JMl ) *DTDUM1/YJM1 

A ( 4 , 3 ) =-DMUDVM* ( 0 . 5* A1 ( I , JMl ) *U2M1 +A2 ( I , JMl ) *UVM1 

>0.5*A3(I, JM1)*V2M1) 

>  -YJZMUM*(A2( I , JMl )*U0RM1+A3( I , JMl ) *V0RM1 )/YJMl 

>  -DKDVM-A4(I, JM1)*T(I, JMl) 

^  -YJZKM*A4( I , JMl ) *DTDVM1/YJM1 

A ( 4 , 4 ) =-DMUDEM* ( 0 . 5* A1 ( I , JMl ) *U2M1 +A2 ( I , JMl ) *UVM1 

>  +0.5*A3( 1, JM1)*V2M1) 

>  -DKDEM*A4( I , JMl ) *T( I , JMl ) 

-  -YJZKM*A4( I , JMl ) *DTDEM1/YJM1 
END  IF 

C( 1, 1)^0. 

C(l,2)=0. 

C(l,3)=0. 

C(l,4)=0. 

C(2  ,  1 )=-DMUDRP* (A1 ( I , J) *U( I , JP1)+A2( I , J ) *V( I , JPl )  ) 

>  +YJZMUP*(A1( I, J)*U0RP1+A2(I, J)*V0RP1)/YJP1 
C(2, 2 )=-DMUDUP* ( Al( I , J)*U( I , JPl )+A2( I , J ) *V( I , JPl ) ) 

>  -YJZMUP*A1 ( I , J ) *0RP1/YJP1 
C(2,3)=-DMUDVP*(A1(I, J)*U(I, JP1)+A2(I, J)*V(I, JPl) ) 

•  -YJZMUP*A2(I, J)*0RP1/YJP1 

C(2, 4)=-DMUDEP*(Al( I , J)*U( I , JPl ) +A2 ( I , J ) *V( I , JPl ) ) 

C(3,  1)=-DMUDRP*(A3(  I  ,  J  )  •*  V (  I ,  JPl )  +  A2  {  I ,  J )  *U (  I  ,  JPl )  ) 
+YJZMUP* ( A3 ( I , J ) *V0RP1+A2 ( I , J ) *U0RP1 )/YJPl 
C(3, 2 )=-DMUDUP*(A3( I , J)*V( I , JPl ) +A2 ( I , J ) *U( I , JPl ) ) 

-  -YJZMUP’"A2(  I  ,  J)*0RP1/YJP1 
C(3,3)=-DMUDVP*(A3( I, J)*V( I, JP1)+A2(I, J)*U(I, JPl) ) 

^  -YJZMUP*A3( I , J)*0RP1/YJP1 

C(3 , 4)=-DMUDEP* (A3( I , J)*V( I , JP1)+A2( I , J)*U( I , JPl ) ) 

C(4, 1 )=-DMUDRP*(0. 5*A1( I , J)*U2P1+A2( I , J)*UVP1 

>  +0.5*A3( I, J)*V2P1) 

>  +YJZMUP*(A1( I, J)*U20RP1+2.0*A2(1, J)*UV0RP1 

>  +A3( I , J)*V20RP1)/YJP1 

>  -DKDRP*A4( I , J) *T( I , JPl ) 

-YJZKP*A4( I , J) *DTDRP1/YJP1 

C(4,2)=-DMUDUP*(0, 5*A1 ( I , J ) *U2P1+A2 ( I , J ) *UVP1 
+0. 5*A3( I , J)*V2P1) 

'  -YJZMUP*(A1( I, J)*UORPl+A2(I, J)*V0RP1)/YJP1 

-  -DKDUP*A4(I, J)*T(I,JP1) 

-YJZKP*A4( I , J)*DTDUP1/YJP1 

C ( 4 , 3 ) =-DMUDVP* ( 0 . 5* A1 ( I , J ) *U2P1 +A2 ( I , J ) *UVP1 
+0. 5*A3( I, J)*V2P1) 

-YJZMUP* ( A2 ( I , J)*U0RP1+A3( I , J ) *VORP 1 ) /YJP 1 
-DKDVP*A4( I , J)*T{ I , JPl ) 

-YJZKP*A4( I , J)*DTDVP1/YJP1 
C(4, 4)--DMUDEP*(0. 5*A1( I , J ) *U2P1 +A2 ( I , J ) *UVP1 

+0.5*A3(I, J)*V2P1) 

-DKDEP*A4( I , J)*T( I , JPl ) 

-YJZKP*A4( I , J)*DTnEPl/YJPl 
B(l,l)-0. 

B(l,2)=0. 

B(l,3)-0. 

B(l,4)=0. 

B(2,  1  )^(DMUDRP*A1  (  I  ,  J)  f  DMUDRM’^  A1  (  I  ,  JMl  )  )*U(I,  J) 

+  (DMUDRP*A2(  I  ,  J)  t-DMUDRM*A2(  I  ,  JMl )  )*V(  I ,  J) 
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-  (  A]  (  I  ,  J  )  -t  YJZMUM*A1  (  I ,  JMl )  )  *UOR/YJ 

-  -  (  YJZ.MLP*  A2  (  1  ,  J  )  +  Y  JZMUM*A2  (  I  ,  JMl )  )  *VOR/YJ 
P(  2  ,  2  )-- (PMljTnr*A.l  (  T  ,  J  )  -H'lMnDUM^A]  (  I  ,  JMl  )  )  *U(  I  ,  J) 

-  ■*  (DMI!LCI"'  A2  (  I  ,  J  )  +L'MUCUM*A2(  I ,  JMl  )  )*V(  I ,  J) 

>  + ( YJZMUF*A1 ( I , J ) +YJZMUM*A1( I , JMl ) )*OR/YJ 
B(2,3)  =  (DMUrVP'Al(  I  ,  J  ) -i  DHUDVM*  A1  (  I,  JMl)  )*U(I,  J) 

^  + (DMUDVF*A2 ( I , J ) +nMUDVM*A2 ( I , JMl ) )*V( I , J) 

>  + ( YJZMWy  ^ A2 ( I , J ) + YJ2MUM*A2 ( I , JMl ) ) *OR/YJ 
B(2 , 4)  =  (DMUDEP' AT  (  I  ,  J  ) -•  DMUDEM*A1  (  I ,  JMl )  )*U(I,  J) 

>  +  (DMUDEF-A;-:  (  l  ,  J)  +DMUDEM*A2(  I  ,  JMI  )  )*V(  I  ,  J) 

B(  3  ,  1  )^(DMUDRP-*A3  (  I  ,  J)  +DMUDRM*A3(  I  ,  JMl )  )*V(  I  ,  J) 

-  +  (DMUDRP-"A2  (  1  ,  J  )  +DMUDRM*A2  (  I  ,  JMl )  )*U(  I ,  J) 

-  (  YJ2MIJP*A3  (  I  ,  J  )  ■»  YJZMUM*A3  (  I ,  JMl )  )  *VOR/YJ 

>  -  (  yjzmup-a;:  (  i  ,  j  )  +  yjzmum*a2  ( i ,  jmi  ) )  *uor/yj 

B ( 3 , 2 )  =  ( DMUDUP  *  A3 ( I , J ) +DMUDUM* A3 ( I , JMl ) ) * V ( I , J ) 

>  +  ( DMUPPAP A2  (  I  ,  J  )  -t  DMUDUM* A2  (  I ,  JMl )  )  *U  (  I  ,  J  ) 

>  + ( YJZMUF'A2 ( I , J ) +YJZMUM*A2 ( I , JMl ) ) *OR/YJ 
B(  3 , 3  )  =  ^DMUr  vP''A3  (  I  ,  J  )  +DMUDVM*  A3  ( I ,  JMl )  )*V(  I  ,  J) 

>  +  ( DMUDV?*A2  (  I ,  J  )  ■^DMUDVM*A2  ( I ,  JMl )  )  *U ( I ,  J ) 

>  + ( YJZMUP*A3 ( I , J  H YJZMUM*A3 ( I , JMl ) ) *OR/YJ 
B(3 , 4)=/DMUDEP*A3 ( I , J ) ‘ DMUDEM* A3 ( I , JMl ) )*V( I , J) 

(DMUDEP*A2  (  I  ,  J  ^  ^  DMUDEM*  A2(  I ,  JMl)  )*U(  I ,  J) 

B  (  4 ,  1  )=0 . 5*  (  DMUDP.P*  A1  (  I  ,  J  )  *DMUDRM*A1  (  I ,  JMl )  )  *U2 

-  +(DMUDRP*A2( r, J)+DMUDRM*A2(I, JMl) )*UV 

>  +0 . 5* (DMUDR?*A3 ( 1 ,  T ) +DMUDRM*A3 ( I , JMl) )*V2 

-  - ( YJZMUP*A1 ( I , J ) +YJZMUM*A1 ( I , JMl ) ) *U20R/YJ 

>  -2 . 0* ( YJZMUP*A2 ( I , J ) +YJ2MUM*A2 ( I , JMl ) ) *UV0R/YJ 
- ( YJZHUP* A3 ( I , J ) +YJZMUM*A3 ( I , JMl ) ) *V20R/YJ 

>  + ( DKDRP* A4 ( I , J ) +DKDRM* A4 ( I , JMl ) ) *T ( I , J ) 

+  (YJZF.P*A4(  I,  J)+YJZKM*A4(I,  JM1))*DTDR/YJ 
B(4, 2  )=0. 5*  (DMUDUP*A1(  I ,  J)  <-DMUDUM*Al  (  I ,  JMl )  )  *U2 

>  +  (DMUDirp*A2  (  i,  J)+DMUDUM*A2(I,  JM1))*UV 

>  +0 . 5  *  (  DMU;.)-;?*  A3  !  I  ,J)  ^-DMUDUM*A3  (  I ,  JMl )  )  *V2 
+  (  YJZMij?*  A1  (  I  ,  J  )  +  Y^ZMUM*A1  (  I ,  JMl )  )  *U''R/YJ 

>  + ( YJZMUPAA2 ( I . J ) +YJZMUM*A2 ( I , JMl ) ) *VOR/YJ 

>  -"(DKDUP*A4(  I  ,  J)  >DKDUM*A4(  I ,  JMl)  )*T(  I ,  J) 

>  + ( YJZKP*A4( r , J) +YJZKM*A4( I , JMl ) )*DTDU/YJ 
B( 4, 3 )=0 . 5* (DMUDVP*A1 ( I , J ) +DMUDVM*A1( I , JMl ) )*U2 

>  *•  ( DMUDVP*  A2  (  I  ,  J  )  +DMUDVM*A2  ( I ,  JMl )  )  *UV 

>  +0 . 5*  (  DMUDyp*A3  (  I  ,  J  )  +DMUD^/M*A3  (  I ,  JMl )  )  *V2 
+ ( Y JZMUP*A2 ( I , J ) +YJZMUM*A2 ( I , JMl ) ) *UOR/YJ 

>  +(YJ2MUP*A3( I, J)+YJZMUM*A3(I, JMl) )*VOR/YJ 

>  +  (DKDyp*A4(  '■  ,  J)  +DKUVM*A4(  I ,  JMl)  )*T(  I  ,  J) 

>  (YJZKP*A4(  I  ,  J)  +YJZKM*A4(  I ,  JMl)  )*DTDV/YJ 
B(4, 4)=0 . 5* (DMUDEP*A1( I , J ) +DMUDEM*A1 ( I , JMl ) )*U2 

>  +(DMUDEP*A2(1, J)+DMUDEM*A2(I, JMl) )*UV 

+  0 . 5  * ( DMUDEP* A3 (1,3) +DMUDEM*A3 { I , JMl ) ) *V2 

>  +■  ( DKDEP*A4  (  I  ,  J  )  +DKDEM*A4(  I ,  JMl )  )  *T  (  I ,  J  ) 
+(Y7ZKP*A4( I , J) +YJZKM*A4( I , JMl ) ) *DTDE/YJ 

COMPUTE  -D'  --DH'  ' /DQ 

AND  ADD  TO  PREVroUS  RESULTS 

IF( JMl . EQ. 1 )  THEN 
CALL  SZERO(4,A) 
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ELSE 

A(2, 1)=A(2, 1 )-EXJ*(V( I , JM1)*DMUDRM1-ZMU( JM1)*V0RM1)/YJM1 
A(2 , 2 )=A(2 , 2 )-EXJ*V( I , JMl ) *DMUDUM1/YJM1 

A(2,3)=A(2,3) -EXJ* ( V( I , JMl ) *DMUDVM1+ZMU ( JMl ) *0RM1 )/YJMl 
A{2,4)=A(2,4) -EX J* V ( I , JMl ) *DMUDEM1/YJM1 
A(3, 1)=A(3, 1)+EXJ*DMUDR/YJ*U(I, JMl) 

>  -EXJ*ZMU{ J)*U0RM1/YJM1 

>  +EYJ*VOR/YJ*ZMU( JMl) 

>  -EYJ*V( I , J)*DMUDRM1/YJM1 
A(3,2)=A(3,2) +EX J*DMUDU/YJ*U( I , JMl ) 

>  +EXJ*ZMU( J)*0RM1/YJM1 

>  -EYJ*V( I , J)*DMUDUM1/YJM1 
A(3,3)=A(3,3) +EX J*DMUDV/Y J*U( I , JMl ) 

>  -EYJ*OR/yj*ZMU( JMl) 

>  -EYJ*V( I, J)*DMUDVM1/YJM1 
A(3,4)=A(3,4) +EXJ*DMUDE/YJ*U( I , JMl ) 

>  -EYJ*V( I , J)*DMUDEM1/YJM1 

A ( 4 , 1 ) ^A ( 4 , 1 ) -EXJ* ( DMUDRMl-2 . 0*ZMU( JMl ) *0RM1 ) *UVM1/YJM1 

>  -EYJ* (DMUDRMl-2 . 0*ZMU( JMl ) *0RM1 ) *V2M1/YJM1 
A(4, 2  )=A(4, 2  )-EXJ*(DMUDUMl*UVMl  +  ZMIJ(  JMl  )*V0RM1  )/YJMl 

>  -EYJ*(DMUDUM1*V2M1)/YJM1 
A(4,3)=A(4,3) -EXJ* ( DMUDVMl *UVM1 +ZMU( JMl ) *U0RM1 ) /YJMl 

>  -EYJ*(DMUDVMl*V2Ml+2 .0*ZMU( JM1)*V0RM1 )/YJMl 
A(4, 4)=A(4, 4)-EXJ*DMUDEMl*UVMl/YJMl 

>  -EYJ*DMUDEM1*V2M1/YJM1 
END  IF 

C(2, 1)=C(2, 1)+EXJ*(V( I, JP1)*DMUDRP1-ZMU( JP1)*V0RP1)/YJP1 
C(2,2)=C(2,2) +EXJ* V ( I , JP 1 ) *DMUDUP1/YJP1 
C(2,3)=C(2,3)+EXJ*(V(I, JP1)*DMUDVP1+ZMU( JP1)*0RP1)/YJP1 
C(2,4)=C(2,4) +EXJ*V ( I , JPl ) *DMUDEP1/YJP1 
C(3,1)=C(3,1) -EXJ*DMUDR/YJ*U ( I , JPl ) 

>  +EXJ*ZMU( J)*U0RP1/YJP1 

>  -EYJ*VOR/YJ*ZMU( JPl) 

>  +EYJ*V( I , J)*DMUDRP1/YJP1 
C(3,2)=:C(3,2)  -EXJ*DMUDU/YJ*U(  I  ,  JPl ) 

>  -EXJ*ZMU( J)*0RP1/YJP1 

>  +EYJ*V{I, J)*DMUDUP1/YJP1 
C{3 ,3)~C{3 ,3) -EX J*DMUDV/Y J*U ( I , JPl ) 

>  +EYJ*OR/YJ*ZMU( JPl) 

>  +EYJ*V( I , J)*DMUDVP1/YJP1 
C(3,4)=C(3,4) -EXJ*DMUDE/YJ*U ( I , JPl ) 

+EYJ*V( I , J)*DMUDEP1/YJP1 

C(4, 1 )=C(4, l)+EXJ*(DMUDRPl-2 .0*ZMU( JP1)*0RP1)*UVP1/YJP1 

>  +EYJ* (DMUDRPl-2 . 0*ZMU( JPl ) *0RP1 ) *V2P1/YJP1 
C(4, 2)=C(4,2)+EXJ*(DMUDUP1*UVP1+ZMU{ JP1)*V0RP1)/YJP1 

>  +EYJ*DMUDUP1*V2P1/YJP1 
C(4,3)=C(4,3) +EX J* ( DMUDVP 1 *UVP 1 +ZMU (JPl)*  UORP 1 ) /Y JP 1 

>  +EYJ*(DMUDVPl*V2Pl+2 .0*ZMU( JP1)*V0RP1 )/YJPl 
C(4, 4)=C(4, 4)+EXJ*DMUDEPl*UVPl/YJPl 

>  +EYJ*DMUDEP1*V2P1/YJP1 
RETURN 

END 

SUBROUTINE  EIGMTX 

*****it**ick-k****->fk-k*******-k***:-k-k*-k-k*-k->c****-k**‘k-k-k*-k**-k-fr**->!-)(***-l(**-k 

* 


139 


FILE:  NPROGll  FOR 


A1  VM/SP  CMS  4-8602  (02/02/88) 


THE  PENNSYLVANIA  STAT 


*  SUBROUTINE  FOR  EIGENVECTOR  MATRIX  CALCULATION 

•k 

kkkkkkkk-kkk'kk'k-kk'k'k’k'k'kk'k'k'k-k'kk'kk-k'k-k'k'k-kkkkic’k'k’k’k’k'k'k'k'k’k'kkk'k'k'k’k'k'k'k'k'k'ic'k 

PARAMETER  ( I Z=60 , JZ=40 ) 

COMMON  /VECTOR/  DQ( IZ, JZ, 4) , Q( IZ, JZ, 4) , F( IZ, JZ, 4) , 

>  G(IZ,JZ,4),  P(IZ, JZ),T(IZ, JZ),E(IZ, JZ),AMW(IZ,JZ), 

-  U( IZ, JZ) , V{ IZ, JZ) ,UN( IZ, JZ),VN( IZ, JZ) , 

>  ZMU( JZ) , ZMUT( JZ) , ZK( JZ) 

COMMON  /COORD/  SAIX ( I Z , JZ ) , SAI Y( IZ , JZ ) , ETAX ( IZ , JZ ) , 

>  ETAY( IZ, JZ) ,RJ( IZ, JZ) ,X( IZ, JZ) , Y( IZ, JZ) , 

>  DELTAU ( I Z , JZ ) , A1 ( I Z , JZ ) , A2 ( I Z , JZ ) , A3 ( I Z , JZ ) , 

>  A4(IZ,JZ) 

COMMON  /CONS/  EXI , EYI , THETA, CFL, CFLl , OMEGAX, OMEGAY, AIN, AEX, 

>  RL , RG , AMWO , GAMMAO , REN , PRN , PRNT , TREF , ZMUO , OMEGA , 

>  PO,TO,TWALL,PB, SUM(4) 

COMMON  /INTEG/  I L , JL , I  LI , JLl , NBEG, NEND, NADV, NORD, ITIME , 

>  IVISC, IWALL, IWRT 

DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ) , RHOV( IZ, JZ) , E0( IZ, JZ) 

EQU I VALENCE  (Q(1,1,1),RH0(1,1)),{Q(1,1,2), RHOU (1,1)), 

>  (Q(l, 1,3),RH0V(1,1)), (Q(1,1,4),E0(1,1)) 
DIMENSION  A(4,4) 

kkkkkkkkkkkkkkkkkk'k’k-kk-k'k-k-k-k-k-k-k-kk'k'k-k'k’k'kic’k-kk'k'k'kkk-k'k'k'kkk'k'k-k'k-k'k'k'k'k’kie 

ENTRY  TMPM( lA, IMID, A, I , J) 

* 

*  _  ]  _  1 

*  CALCULATION  OF  T  *P  MATRIX 

* 

*  IF  IA=1  IMID-=0  -  XI  MATRIX  CALCULATED  IN  POINT  (I,J) 

*  IF  IA=2  IMID=0  -  ETA  MATRIX  CALCULATED  IN  POINT  (I,J) 

*  IF  IA=^1  IMID=1  -  XI  MATRIX  CALCULATED  IN  POINT  ( 1  +  1/2,  J) 

*  IF  IA=2  IMID=1  -  ETA  MATRIX  CALCULATED  IN  POINT  (I,J+l/2) 

•k 

kkkkkkkkkk-kkk-k-k-k-k'kk'k'kk-kk-kkk'k’kk-k-k'k-k-k-k'k'kkk'kk-k'k'k'k'k'k'k-k'k'k'k'kitk'k'k'k’k'k'k'k'k 

IF( ( lA.EQ. l.AND. IMID.EQ.O) .OR. 

>  ( lA. EQ. 1 . AND. IMID. EQ. 1 . AND. I .EQ. IL) )  THEN 
CX=SAIX( I , J) 

CY=SAIY( I , J) 

QRHO^RHO ( I , J ) 

QU=U(I, J) 

QV=V(I, J) 

QEO=EO( I , J) 

QP-P(I, J) 

QCN^UN( I , J) 

QE-E(I, J) 

QT=T(I, J) 

QAMW=AMW ( I , J ) 

END  IF 

IF( ( I A. EQ. 2. AND. IMID . EQ . 0 ) . OR . 

>  (lA. EQ. 2. AND. IMID. EQ. l.AND. J.EQ.JL))  THEN 
CX=ETAX( I , J) 

CY=ETAY( I , J) 

QRHO=RHO( I , J) 

QU=U(I, J) 

QV=V( I , J) 
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QE0=E0( I , J) 

QP=P(I, J) 

QCN=VN(I, J) 

QE=E(I, J) 

QT=T(I, J) 

QAMW=AMW( I , J) 

END  IF 

IF( lA.EQ. 1 .AND. IMID.EQ. 1 . AND . I .NE. IL)  THEN 

CALL  AVERAGE ( I A , I ROE , CX , CY , QRHO , QU , QV , QEO , QP , QCN , 

>  QE,QT,QAMW, I, J) 

END  IF 

IF( IA.EQ.2 . AND. IMID.EQ. 1 . AND . J . NE . JL )  THEN 

CALL  AVERAGE ( I A , I ROE , CX , CY , QRHO , QU , QV , QEO , QP , QCN , 

>  QE,QT,QAMW, I, J) 

END  IF 

SQ2=SQRT(2 . 0) 

C=SQRT ( FC02 ( QP , QRHO , QT , QE , QAMW ) ) 

AR=FAR ( QP , QRHO , QT , QE , QAMW ) 

AE=FAE ( QP , QRHO , QT , QE , QAMW ) 

AER=AE/QRHO 

DPDR=AR+AER* { -QEO/QRHO+ (QU**2+QV**2 ) ) 

DPDU=-AER*QU 

DPDV=-AER*QV 

DPDE=AER 

C1=CX/SQRT(CX**2+CY**2) 

C2=CY/SQRT(CX**2+CY**2 ) 

A(l, 1)=1.-DPDR/C**2 

A( 1, 2 )=-DPDU/C**2 

A(l, 3)=-DPDV/C**2 

A{ 1, 4)=-DPDE/C**2 

h{2, 1)=-(C2*QU-C1*QV)/QRH0 

A(2,2)=C2/QRHO 

A(2,3)=-C1/QRH0 

A(2, 4)=0. 

A(3,1)=(-(C1*QU+C2*QV) + DPDR/C ) /SQ2 /QRHO 
A ( 3 , 2 ) = ( Cl +DPDU/C ) /SQ2/QRH0 
A ( 3 , 3 )  =  ( C2  +DPDV/C ) /SQ2/QRH0 
A ( 3 , 4 ) =DPDE/C/SQ2/QRH0 

A{4, 1 )=( (Cl*QU+C2*QV)+DPDR/C)/SQ2/QRHO 
A ( 4 , 2 ) = ( - C 1 +DPDU/C ) /SQ2/QRH0 
A ( 4 , 3 ) - ( -C2  +DPDV/C ) /SQ2/QRH0 
A ( 4 , 4 ) =DPDE/C/SQ2/QRH0 
RETURN 


ENTRY  PPTP( lA, IMID, A, I , J) 

•k’k^-k'k'k'k'k-k-k'k'k'k'k'k'kic'k'k'k'k'k'k'k'k'k^'k'k'k'k'k'k'kic'k'k'k-k'k'k'k'k'k’k’k’k’k-k'k'k'k'k'k'k’k-k'k-k'k-k-k'k-k 

* 

*  CALCULATION  OF  P*T  MATRIX 

* 

*  IF  IA=1  IMID=0  -  XI  MATRIX  CALCULATED  IN  POINT  (I,J) 

*  IF  IA=2  IMID=0  -  ETA  MATRIX  CALCULATED  IN  POINT  (I,J) 

*  IF  IA=1  IMID=1  -  XI  MATRIX  CALCULATED  IN  POINT  ( 1+1/2, J) 

*  IF  IA=2  IMID=1  -  ETA  MATRIX  CALCULATED  IN  POINT  (I,J+l/2) 

* 

**************************************************************** 
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IF( ( lA.EQ. 1 .AND. IMID.EQ.O) .OR. 

>  ( lA.EQ. 1. AND. IMID.EQ. l.AND. I.EQ. IL) )  THEN 
CX=SAIX( I , J) 

CY=SAIY(I, J) 
eRHO=RHO ( I , J ) 

QU-U(I, J) 

QV=V(I, J) 

QEO=EO( I , J) 

QP=P(I, J) 

QCN=UN{ I , J) 

QE=E(I, J) 

QT=T(I, J) 

QAMW=AMW( I , J) 

END  IF 

IF( ( IA.EQ.2 . AND. IMID.EQ.O) .OR. 

>  (IA.EQ.2.AND.IMID.EQ.1.AND.J.EQ.JL))  THEN 
CX=ETAX(I, J) 

CY=ETAY( I , J) 

QRHO=RHO(I, J) 

QU=U(I, J) 

QV=V(I, J) 

QEO=EO( I , J) 

QP=P(I, J) 

QCN=VN( I , J) 

QE=E(I, J) 

QT=T(I, J) 

QAMW=AMW ( I , J ) 

END  IF 

IF( lA.EQ. 1 . AND. IMID.EQ. l.AND. I .NE. IL)  THEN 

CALL  AVERAGE ( I A, IROE , CX, CY, QRHO, QU, QV, QEO , QP , QCN, 

>  QE,QT,QAMW,I,J) 

END  IF 

I F ( I A . EQ . 2 . AND . IMID . EQ . 1 . AND . J . NE . JL )  THEN 

CALL  AVERAGE( lA, IROE , CX, CY, QRHO, QU, QV, QEO , QP , QCN, 

>  QE,QT,QAMW,I,J) 

END  IF 

SQ2=1./SQRT(2.0) 

C=SQRT ( FC02 ( QP , QRHO , QT , QE , QAMW ) ) 

AR=FAR ( QP , QRHO , QT , QE , QAMW ) 

AE=FAE ( QP , QRHO , QT , QE , QAMW ) 

AER=AE/QRHO 

DPDR=AR+AER* ( -QEO/QRHO+ (QU**2+QV**2 ) ) 

DPDU=-AER*QU 

DPDV=-AER*QV 

DPDE=AER 

CXCY=1 ./SQRT(CX**2+CY**2 ) 

C1-CX*CXCY 

C2=CY*CXCY 

A(l,l)=l. 

A(l,2)=0. 

A{l,3)=QRHO*SQ2/C 

A(1,4)=A(1,3) 

A(2,1)=QU 

A(2,2)=QRHO*C2 

A(2, 3 )=SQ2*QRH0*(QU/C+C1) 
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A ( 2 , 4 ) =SQ2*QRHO* ( QU/C-Cl ) 

A{3,1)-QV 

A{3,2)=-QRH0*C1 

A ( 3 , 3 ) =SQ2*QRHO* ( QV/C+C2 ) 

A ( 3 , 4 ) =SQ2  *QRHO* ( QV/C-C2 ) 

A ( 4 , 1 ) =QEO/QRHO-QRHO* AR/AE 
A(4, 2 )=QRH0*(QU*C2-QV*C1) 

TEMP 1=SQ2  *QRHO*  *2  *C/AE 
TEMP2=SQ2*QRHO* (QU*C1+QV*C2 ) 
A(4,3)=A(4,1) *QRHO*  SQ2/C+TEMP 1 +TEMP2 
A(4, 4)=A(4, 1)*QRH0*SQ2/C+TEMP1-TEMP2 
RETURN 
END 

SUBROUTINE  FLXCL 


SUBROUTINE  FOR  FLUX  VECTOR  CALCULATION 


'kir'k'k'k'k'k'k'k'k'kif'k-k'k’k-k'k’k’k'k’k’k'k’k'k'kic'k'k'k-k'k'k'k'k'k'kic'k’k'k'k'k'k'k'k'k'k'k'k'k'k'k'k'k'k'k'k-k'k'k'k'k 

PARAMETER  ( I 2=60 , JZ=40 ) 

COMMON  /VECTOR/  DQ ( 12 , JZ , 4 ) , Q ( IZ , JZ , 4 ) , F( I 2 , JZ , 4 ) , 

>  G(IZ,JZ,4),  P(IZ, JZ),T(IZ, JZ),E(IZ, JZ),AMW(IZ, JZ), 

>  U( IZ, JZ) , V( 12, JZ) ,UN( IZ, JZ), VN(IZ, JZ) , 

>  ZMU( JZ) ,ZMUT( JZ) ,ZK( JZ) 

COMMON  /COORD/  SAIX ( I Z , JZ ) , SAI Y( IZ , JZ ) , ETAX( IZ , JZ )  , 

^  ETAY( IZ, JZ) ,RJ( IZ, JZ) ,X( IZ, JZ) , Y( IZ, JZ) , 

>  DELTAU( IZ, JZ) , Al( IZ, JZ) ,A2(IZ, JZ) , A3( IZ, JZ) , 

>  A4(IZ,JZ) 

COMMON  /CONS/  EXI , EYI , THETA, CFL, CFLl , OMEGAX, OMEGAY, AIN, AEX, 

>  RL , RG , AMWO , GAMMAO , REN , PRN , PRNT , TREF , ZMUO , OMEGA , 

>  P0,T0,TWALL,PB,SUM(4) 

COMMON  /INTEG/  I L, JL, ILl , JLl , NBEG, NEND, NADV, NORD, ITIME , 

>  IVISC, IWALL, IWRT 

DIMENSION  RHO( IZ, JZ) ,RHOU{ IZ, JZ) ,RHOV( IZ , JZ ) , EO ( IZ , JZ ) 
EQUIVALENCE  (Q( 1 , 1 , 1 ) , RHO( 1 , 1 ) ) , ( Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(1,1,3),RH0V(1,1)), (Q( 1,1,4), E0( 1,1)) 
DIMENSION  A(4,4) 

*****  +  ****•****************************************************** 
ENTRY  FLXE(II) 

•k'k’k'kif'k’k'k’k'k'k'k'k'kic-kic-k'k’k’k'kic'k'k'k'k'k'k'k'k'k'k'k'kic'k'k'kic'kie'k'k'k'k'k'k'k'k'k'k'k'k'k'k'k'k'k'k'k'k'k'k 


*  COMPUTE  CONVECTIVE  FLUX  VECTOR  E 

* 

I  =  II 

DO  10  J=1,JL 

F(I, J,1)=RH0(I, J)*UN(I, J)/RJ(I, J)*Y(I, J) 

F(I, J,2)=(RH0U(I, J)*UN(I, J)+SAIX(I, J)*P(I, J) )/RJ( I , J) *Y( I , J) 
F(I, J,3)=(RH0V( I, J)*UN(I, J)+SAIY(I, J)*P(I, J) )/RJ ( I , J ) *Y( I , J ) 
F(I, J,4)=(E0(I, J)+P(I, J))*UN(I, J)/RJ(I, J)*Y(I, J) 

10  CONTINUE 
RETURN 

ENTRY  FLXF(II) 
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*  COMPUTE  CONVECTIVE  FLUX  VECTOR  F 

* 

I  =  II 

DO  20  J=1,JL 

G( I , J, l)=RHO( I, J)*VN(I, J)/RJ(I, J)*Y(I, J) 

G(I, J,2)=(RHOU(I, J)*VN(I, J)+ETAX(I, J)*P(I, J))/RJ(I, J)*Y(I, J) 
G(I, J,3)=(RHOV(I, J)*VN(I, J)+ETAY(I, J)*P(I, J) )/RJ(I, J)*Y(I, J) 
G(I, J,4)=(E0(I, J)+P(I, J))*VN(I, J)/RJ(I, J)*Y(I, J) 

20  CONTINUE 
RETURN 


ENTRY  FLXEP( II , IMID) 


*  E  FLUX  VECTOR  (IMID=0) 

* 

*  +  + 

*  DE  =A  (1+1/2, J)*(Q(I+1,J)-Q(I,J))  (IMID=1) 


I  =  II 

IF( IMID.EQ.O)  THEN 
DO  30  J=1,JL 

CALL  JCBABPM(1,1,0,A, I, J) 

DO  31  K=l,4 
F(I,J,K)=0. 

DO  31  JJ=1,4 

F(I, J,K)=F(I, J,K)+A(K, JJ)*Q(I, J, JJ)/RJ(I, J)*Y(I, J) 

31  CONTINUE 
30  CONTINUE 
END  IF 

IF( IMID.EQ. l.AND. I .NE. IL)  THEN 
DO  35  J=1,JL 

CALL  JCBABPM( 1, 1, 1, A, I , J) 

DO  36  K=l,4 
F(I, J,K)=0. 

DO  36  JJ=1,4 
YM=0.5*(Y(I, J)+Y(I+1, J) ) 

RJM=0.5*(RJ(I, J)+RJ(I  +  1,  J) ) 

F( I , J,K)=F( I, J,K)+A(K, JJ)*(Q(I+1, J, JJ)-Q( I, J, JJ) )/RJM*YM 
36  CONTINUE 
35  CONTINUE 
END  IF 

IF(IMID.EQ. l.AND. I .EQ. IL)  THEN 
DO  37  J=1,JL 

CALL  JCBABPM(1,1,0,A, I, J) 

DO  38  K=l,4 
F(I, J,K)=0. 

DO  38  JJ=1,4 
YM=Y ( I , J ) 

RJM=RJ( I , J) 

F( I , J,K)=F( I , J,K)+A(K, JJ)*(Q(I, J, JJ)-Q( I-l, J, JJ) )/RJM*YM 
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38  CONTINUE 
37  CONTINUE 
END  i  n 
RETURN 

ENTRY  FLXEM( II , IMID) 


E  FLUX  VECTOR  (IMID=0) 


*  DE  =A  (1+1/2, J)*(Q(I+1,J)-Q(I,J))  (IMID=1) 

* 

I  =  I  I 

IF( IMID.EQ.O)  THEN 
DO  40  J=1,JL 

CALL  JCBABPM( 1, 2, 0, A, I , J) 

DO  41  K=l,4 
G( I , J,K)=0. 

DO  41  JJ=1,4 

G( I, J,K)=G(I, J,K)+A(K, JJ)*Q(I, J, JJ)/RJ(I, J)*Y(I, J) 

41  CONTINUE 
40  CONTINUE 
END  IF 

IF(IMID.EQ. l.AND. I .NE. IL)  THEN 
DO  45  J=1,JL 

CALL  JCBABPM(1,2, 1,A, I, J) 

DO  46  K=l,4 
G( I , J, K)=0. 

DO  46  JJ=1,4 
YM=0.5*(Y(I, J)+Y(I+1, J)) 

RJM-:0.5*(RJ(  I,  J)+RJ(I  +  1,  J)  ) 

G(I,J,K)=G(1,J,K)+A(K,JJ)*(Q(I+1,J,JJ)-Q(I,J,JJ) )/RJM*YM 

46  CONTINUE 
45  CONTINUE 

END  IF 

IF( IMID. EQ. l.AND. I .EQ. IL)  THEN 
DO  47  J=1,JL 

CALL  JCBABPM(1,2,0,A, I, J) 

DO  48  K=l, 4 
G(I, J,K)^0. 

DO  48  JJ=1,4 
YM^Y( I , J) 

RJM=RJ( I , J) 

G( I , J,K)=G( I, J,K)+A(K, JJ)*(Q( I, J, JJ)-Q( I-l, J, JJ) )/RJM*YM 
48  CONTINUE 

47  CONTINUE 
END  IF 
RETURN 

ENTRY  FLXFP( II, IMID) 
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*  F  FLUX  VECTOR  (IMID=0) 

* 

*  4.  + 

*  DF  =B  (I, J+1/2)*(Q( , J+1)-Q(I, J))  (IMID=1) 

* 

I  =  II 

IF( IMID.EQ.O)  THEN 
DO  50  J=1,JL 

CALL  JCBABPM(2, 1,0,A, I, J) 

DO  51  K=l,4 
F(I, J,K)=0. 

DO  51  JJ=1,4 

F(I, J,K)=F(I, J,K)+A(K, JJ)*Q(I, J, JJ)/RJ(I, J)*Y( I, J) 

51  CONTINUE 
50  CONTINUE 
END  IF 

IF( IMID.EQ. 1 . AND. J.NE. JL)  THEN 
DO  55  J=1,JL1 
CALL  JCBABPM(2, 1, 1,A, I, J) 

DO  56  K=l,4 
F(I, J,K)=0. 

DO  56  JJ=1,4 
YM=0.5*(Y( I , J)+Y( I, J+1) ) 

RJM=0 . 5* ( RJ ( I , J ) +RJ ( I , J+1 ) ) 

F(I, J,K)=F(I, J,K)+A(K, JJ)*(Q(I, J+1, JJ)-Q(I, J, JJ) )/RJM*YM 
56  CONTINUE 
55  CONTINUE 
END  IF 

;F( IMID.EQ. 1. AND. J.EQ.JL)  THEN 
CALL  JCBABPM(2, 1,0,A, I, J) 

DO  58  K=l,4 
F( I, J,K)=0. 

DO  58  JJ=1,4 
YM=Y( I , J) 

RJM=RJ(I, J) 

F( I, J,K)=F(I, J,K)+A(K, JJ)*(Q(I, J, JJ)-Q(I, J-1, JJ) )/RJM*YM 
58  CONTINUE 
END  IF 
RETURN 

ENTRY  FLXFM( II, IMID) 

il'k'k'k'k'k'k'k-k-k-k'k-k'k'k'k'kit-k’k'k'k'k'k'k-k'k'k'k’k'k'kit'kieic'k'k'kidc’k'k'kirie-k'k'k'k'k'k'k'k'k'k'k'k'kic'k'k'k'k 


F  FLUX  VECTOR  (IMID=0) 


*  DF  =B  (I,J>i/2)*(Q(I, 


I  =  II 

IF( IMID.EQ.O)  THEN 
DO  60  J=1,JL 
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CALL  JCBABPM(2,2,0,A, I, J) 

DO  61  K^l,4 

^  f  T  T  Tr>  - 

.  .  ^  1  ,  V,  ,  IV  ;  v>  . 

DO  6  1  .JJ-1,4 

G( T, J,K)=G( I , J,K)+A(K, JJ)*Q(I, J, JJ)/RJ{I, J)*Y(I, J) 

61  CONTINUE 
60  CONTINUE 
END  IF 

IF(  IMID.EQ.  1  .  AND.  J.NE.  JI.)  THEN 
DO  65  J-1,JL1 
CALL  JCBABPM(2, 2, 1, A, I , J) 

DO  66  K=l,4 
G ( I , J , K ) =0 . 

DO  66  JJ=1,4 
YM=0.5*(Y(I, J)+Y(I, J+1) ) 

RJM=0 . 5* ( RJ ( I , J ) +RJ ( I , J+ 1 ) ) 

G( I, J,K)-C( T . j,K)+A(K, JJ)*(Q(I, J+1, JJ)-Q( I, J, JJ) )/RJM*YM 
66  CONTINUE 
65  CONTINUE 
END  IF 


IF( IMID.EQ. 1. AND. J.EQ.JL)  THEN 
CALL  JCBABPM(2,2,0,A, I, J) 

DO  68  K=l,4 
G(I, J,K)=0. 

DO  68  JJ=1,4 
YM-Y ( I , J ) 

RJM=RJ( I , J) 


G(I,  J,K)=G(I,,T,K)+A(K,  JJ)*(Q(I,  J,  JJ)-Q(I,  J-1,  JJ))/RJM*YM 
68  CONTINUE 
END  IF 
RETURN 


ENTRY  FLXSVS(II) 


V.  *  *  *  *  * 


*  VISCOUS  FLUX  VECTOR,  (DSVS ' /DETA) +H' ' 

* 

* 

*  VISCOUS  FLUX  VECTOR  DSVS '/DETA 

■k 

I^l  I 

DO  70  J=2,JL1 
JP1-.J  +  1 
JM1=J-1 

YJP=0.5*(Y( I , J)/RJ( I, J)+Y(I, JP1)/RJ(I, JPl) ) 
Y JM^O . 5  * ( Y { I , J ) /R J (I,J)+Y(I,JM1) /R J ( I , JMl ) ) 
ZMUP=0.5*(ZMU( J)+ZMU( JPl) ) 
ZMUM=0.5*(ZMU(J)+ZMU( JMl) ) 

ZKP=0.5*(ZK( J)+ZK( JPl) ) 

ZKM=0. 5*(ZK( J)+ZK( JMl) ) 

DUP=U( I , JPl )-U( I , J) 

DUM=U(I, J)-U(I, JMl) 

DVP=V(I, JP1)-V(I, J) 

DVM=V( I , J)-V( I , JMl ) 
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* 

* 

* 

* 

* 

* 

* 

* 

•k 

k 

k 

k 

k 

k 

k 

k 

k 

k 


DU2P=U( 1, JP1)**2-U( I, J)**2 
DU2M=U( I , J) **2-U( I , JMl )**2 
DV2P=V(I, JP1)**2-V(I, J)**2 
DV?M=V(  I,  .T)**?-V(  I,  JM1)’'*2 
DUVP=U(I, JP1)*V( I, JP1)-U{I, J)*V(I, J) 

DUVM=U ( I . J ) *V{ I , J ) -U( I , JMl ) *V( I , JMl ) 

DTP=T(I, JP1)-T(I, J) 

DTM=T(I, J)-T(I, JMl) 

ZMUA1P=ZMUP*A1 ( I , J ) 

ZMUA1M=ZMUM*A1 ( I , JMl ) 

ZMUA2P=ZMUP*A2 ( I , J ) 

ZMUA2M=ZMUM*A2 ( I , JMl ) 

ZMUA3P=ZMUP*A3 ( I , J ) 

ZMUA3M=ZMUM*A3 ( I , JMl ) 

ZKA4P=ZKP*A4( I, J) 

ZKA4M=ZKM* A4 ( I , JMl ) 

G(I, J,1)=0. 

G( I , J, 2 )=YJP*(ZMUA1P*DUP+2MUA2P*DVP) 

>  -YJM*(ZMUA1M*DUM+ZMUA2M*DVM) 

G ( I , J , 3 ) =YJP* ( ZMUA3P*DVP+ZMUA2P*DUP ) 

>  -YJM*(ZMUA3M*DVP+ZMUA2M*DUM) 

G( I , J, 4)=YJF*(0. 5*ZMUAlP*DU2P+ZMUA2P*DUVP+0. 5*ZMUA3P*DV2P 

>  +ZKA4P*DTP) 

>  -YJM* (0. 5*ZMUAlM*DU2M+ZMUA2M*DUVM+0. 5*ZMUA3M*DV2M 

>  +ZKA4M*DTM) 

INSERT  THE  EXTRA  FIRST  ORDER  TERMS  IN  CYLINDRICAL 
COORDINATE  SYSTEMS,  VECTOR  H’ ' 


H(1)=0. 

1  2 

H(2)=-*(--*ETA  *D(MU*V)/DETA 
J  3  X 

12  2 
H(3)^-*(-*ETA  *MJ*DU/DETA  --*V*ETA  *DMU/DETA) 

J  3  X  3  Y 

12  2 
H(4)=-*(--*ETA  *D(MU*U-V)/DETA  --*ETA  *D(MU*V*V)/DETA) 
J  3  X  3  Y 


EXJ=1./3.*ETAX(I, J)/RJ(I, J) 

EYJ=1./3.*ETAY(I, J)/RJ(I, J) 

G( I, J,2)=G(I, J,2)-EXJ*(ZMU(JP1)*V(I, JP1)-ZMU(JM1)*V(I, JMl) ) 
G( I, J,3)=G(I, J,3)+EXJ*ZMU( J)*(U(I, JP1)-U(I, JMl) ) 

>  -EYJ*V(I, J)*(ZMU(JP1)-ZMU(JM1)) 

G( I, J,4)=G( I, J,4)-EXJ*(ZMU( JP1)*U(I, JP1)*V(I, JPl) 

>  -ZMU( JM1)*U(I, JM1)*V(I, JMl) ) 

>  -EYJ*(ZMU(JP1)*V(I, JP1)**2 

>  -ZMU(JM1)*V(I, JM1)**2) 

70  CONTINUE 

RETURN 

END 
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SUBROUTINE  RHSCL 

******************************************************************** 

★ 

*  RIGHT  HAND  SIDE  CALCULATION 

* 

*****-A***************************************-******************* 

PARAMETER  (  I  Z=60 ,  JZ=:40  ) 

COMMON  /VECTOR/  DQ(  I Z  ,  .TZ ,  4  )  ,  Q (  IZ ,  JZ ,  4 )  ,  F  (  I Z ,  JZ ,  4 )  , 

>  G(IZ,JZ,4),  P(  IZ,-JZI  ,T(  IZ,  JZ)  ,E(IZ,  jZ)  ,  AMW(  IZ,  JZ)  , 

>  U( IZ, JZ) , V( IZ, JZ) ,UN(IZ, JZ),VN( IZ, JZ) , 

>  ZMU( JZ) , ZMUT( JZ) , ZK( JZ) 

COMMON  /COORD/  SAIX ( I Z , JZ ) , SAI Y( I Z , JZ ) , ETAX ( IZ , JZ ) , 

>  ETAY( IZ, JZ) , RJ( IZ, JZ) ,X( IZ, JZ) , Y( IZ, JZ) , 

->  DELTAU  (  I Z ,  JZ  )  ,  A1  (  I Z  ,  JZ  )  ,  A2  (  I Z ,  JZ  )  ,  A3  (  I Z  ,  JZ  )  , 

>  A4(I2,JZ) 

COMMON  /CONS/  EXl , EYI , THETA, CcL, CFLl , OMEGAX, OMEGAY, AIN, AEX, 
RL , RG , AMWO , GAMMAO , REN , PRN , PRNT , TRE  F , ZMUO , OMEGA , 

>  PO,TO,TWALL,PB, SUM(4) 

COMMON  /INTEG/  I L, JL, I  LI , JLl , NBEG, NEND , NADV , NORD ,  ITIME , 

>  IVISC, IWALL, IWRT 

DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ) ,RHOV( IZ , JZ ) , EO ( I Z , JZ ) 
EQUIVALENCE  (Q( I , 1, I) ,RHO( 1, 1)),(Q(1,1,2) , RHOU ( 1 , 1) ) , 
(Q(1,1,3),RH0V(1,1)), (Q(1,1,4),E0(1,1)) 

icic'k'k'k'k'k'k’kif'kit'k'kiritirir'kitifirif'kic-k'k'k-k'k'k'^'k'k'kic'k'k-k-k-k-k'k'k'k-k'k'k’k-k'k'kirir-kic'k-k-k'k'k'k'k'k 

ENTRY  RHSEF(II) 

'k-k'k-fr'k^-ky;  A  }!-k'k'k-k'M  ''ie')r'k-k-k-k-k'k'k-k-k-k-k-k'k'k’k'kic^'k'k'k-k'k'k’k-k'k‘k'k-k'k'k’ff-k-k'k'k-k-k‘k-k'k'k'k'k 
•k 

*  RIGHT  HAND  SIDE  CONVECTIVE  EULER  TERMS  E,  F 

* 

*  NOTE  -  SEE  ALSO  ENTRY  RHSH  FOR  SOURCE  CONVECTIVE  TERM  OF  H' 

k 

kkkkk-*-kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

l  =  i  I 

DO  10  J=^1,JL 
DO  10  K=l,4 
DQ( I , J, K)=0 . 

10  CONTINUE 

* 

*  COMPUTE  E(I-1,J),  E(I+1,J),  F(I,J-1),  F(I,J+1)  -  1ST  ORDER 

* 

CALL  FLXE(I-l) 

IF(I.NE.IL)  THEN 
CALL  FLXE(I+1) 

ELSE 

CALL  FLXE(I) 

CALL  FLXE( 1-2 ) 

END  IF 
CALL  FLXF( I ) 

DO  20  J=2,JL 
DO  20  K=l,4 
IF(J.HE.JL)  THEN 
I F ( I . NE . I L )  THEN 

DQ( I, J,K)=DO(I, J,K)+0.5*{F(I  +  1, J,K)-F( I-l, J,K)  ) 

+0.5*(G(T, J+1,K)-G(I, J-I ,K) ) 

ELSE 
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DQ( I, J,K)-DQ(I, J,K)+(F( I, J,K)-F(I-1, J,K) ) 

>  +0.5*(G{I, J+1,K)-G(I, J-1,K) ) 
+0.5*(F( I, J,K)-2.0*F(I-1, J,K)^F(I-2, J,K) ) 

END  IF 
ELSE 

I F ( I . NE . I L )  THEN 

DQ( I, J,K)=DQ(I, J,K)+0.5*(F(I+1, J,K)-F(I-1, J,K) ) 

>  +(G(I, J,K)-G(I, J-1,K)) 

>  +0.5*(G(I, J,K)-2.0*G(I, J-1,K)+G{I, J-2,K) ) 

ELSE 

DQ( I , J,K)=DQ(I, J,K)+(F( I, J,K)-F(I-1, J,K) ) 

^  +(G(I, J,K)-G(I, J-1,K)) 

+0.5*(F(I,J,K)-2.0*F(I-1,J,K)+F(I-2,J,K)) 

>  +0. 5*(G( I, J,K)-2.0*G(I, J-1,K)+G(I, J-2,K) ) 
END  IF 

END  IF 
20  CONTINUE 

■k 

*  COMPUTE  D/E( 1-1/2, J)/,  D/E(I+1/2,J)/  -  1ST  ORDER 

CALL  FLXEP( 1-1,1) 

CALL  FLXEM( I-l, 1) 

CALL  FLXEP( 1,1) 

CALL  FLXEM( 1,1) 

DO  30  J=2,JL 

DO  30  K=l,4 

IF( I .NE. IL)  THEN 

D0(  I,  t,K)=:DQ(I,  J,K)-0.5*(F(I,  J,K)-F(I-1,  J,K)  ) 

>  +0.5*(G(I,J,K)-G(I-1, J,K)) 

ELSE 

DQ( I, J,K)=DQ(I, J,K)-(F( I, J,K)-F(I-1,  J,K) ) 

>  +(G(I,J,K)-G(I-1,J,K)) 

END  IF 

30  CONTINUE 

k 

*  COMPUTE  D/F( I , J-1/2 )/,  D/F( I , J+1/2 )/  -  1ST  ORDER 

k 

CALF,  FLXFP{I,1) 

CALL  FLXFM( 1,1) 

DO  35  J=2,JL 
DO  3  5  K=^l,4 
IF(J.NE.JL)  THEN 

DQ( T, J,K)=DQ(I, J,K)-0.5*(F(I, J,K)-F(I, J-1,K) ) 

+0.5*(G(I, J,K)-G(I, J-1,K) ) 

ELSE 

DQ( I, J,K)=DQ(I, J,K)-(F(I, J,K)-F(I, J-1,K)) 

>  +(G( I, J,K)-G(I, J-1,K) ) 

END  IF 

35  CONTINUE 

* 

*  +  - 

*  COMPUTE  DE  ,  DE  -  2ND  ORDER 

* 

I F ( I . GT . 2 . AND . I . LT . I L )  THEN 
CAF-L  FLXEP(  1-2, 1) 


150 


FILE:  NPROGll  FOR 


A1  VM/FP  CMS  4-8602  (02/02/88) 


THE  PENNSYLVANIA  STAT 


CALL  FLXEP( 1-1,1) 

CALL  FLXEM( 1,1) 

CALL  FLXEM( 1+1,1) 

ELSE 
END  IF 

DO  40  J=2,JL 
DO  40  K--l,4 

IF( I . EQ. 2 . OR. I . EQ. IL)  GO  TO  40 
IF( I .NE. IL-1)  THEN 

DQ{ J, J,K)=DQ( I, J,K)+0. 5*(F( I-l,  J,K)-F( 1-2,  J,K) ) 
>  -0.5*(G(I+1, J,K)-G(I, J,K) ) 

ELSE 

DQ( I , J. K^=DO( I,J,K)+0.5*(F(I-1,J,K)-F(I-2,J,K)) 

-(G(I+1, J,K)-G(I, J,K) ) 

END  IF 
40  CONTINUE 


* 

* 


COMPUTE  DF 


DF  -  2ND  ORDER 


CALL  FLXFP(I, 1) 

CALL  FLXFM( 1,1) 

DO  45  J=2,JL 
DO  45  K=l,4 

IF(J.EQ.2.0R. J.EQ. JL)  GO  TO  45 
IF( J.NE. JL-1)  THEN 

DQ( T, J,K)=DQ(I, J,K)+0.5*(F(I, J-1,K)-F(I, J-2,K) ) 
-  -0.5*(G(r, J+1,K)-G(I, J,K) ) 

ELSE 

D9( I, J,K)=DQ( I, J,K)+0.5*(F(I, J-1,K)-F(I, J-2,K) ) 

-(G(I, J+1,K)-G(I, J,K) ) 

END  IF 
45  CONTINUE 
RETURN 

'k-k'k-k-k-k'kk-k'k-k’k’k'kic'k'k'kk' 

ENTRY  RHSH{II) 


SOURCE  VECTOR  H' 

H(1)=0. 

H(2)=0. 

H(3 )=(P-4./3 . *MU*V/Y)/J 
H(4)=0. 


I^II 

DO  50  J=2,JL 
IF( IVISC.EQ.O)  THEN 
R2MY=0 . 

ELSE 

R2MY=4./3 . *ZMU( J)*V( I , J ) / ( R J ( I , J ) *Y( I , J ) ) 
END  IF 

DQ(  I  ,  J,  3  )=Dr)(  I ,  J,  3  )-P(  I  ,  J)/RJ(  I,  J)  +  IVISC*R2MY 
50  CONTINUE 
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RETURN 

***********x**************************************************** 

ENTRY  RHSVS( 1 1 ) 

*-lr*Jr****x****-V****************  +  ********************************* 

4- 

*  RIGHT  HAND  SIDE  VISCOUS  TERMS 

* 

*  NOTE  -  SEE  ALSO  ENTRY  RHSH  FOR  SOURCE  VISCOUS  TERMS  OF  H' 

**  +  **  +  *'Jr*******  +  *************  +  ********************************** 

I  =  I  I 

CALL  FLXSVS(I) 

DO  90  J=2 , JLl 
DO  90  K=2,4 

DQ ( I , J , K ) =DQ (I,J,K)-G(I,J,K) 

90  CONTINUE 
RETURN 
END 

SUBROUTINE  SMOOTH 

******x-l-***  +  ***************  +  ********'***********-*-**************** 

* 

*  ADD  ARTIFICIAL  D I SS I RATIONAL  TERM  FOR  SAI ,  ETA  -  DIRECTION 

* 

*******■*•  +  *****************•*•************************************* 
PARAMETER  ( I Z=60 , JZ=40 ) 

COMMON  /VECTOR/  DQ ( I Z , JZ , 4 ) , Q{ I Z , JZ , 4 ) , F ( I Z , JZ , 4 ) , 

>  G(IZ,JZ,4),  P(IZ, JZ),T(IZ,JZ),E(IZ, JZ),AMW(IZ, JZ), 

^  U( IZ, JZ) , V( IZ, JZ) ,UN( IZ, JZ) ,VN( IZ, JZ) , 

^  ZMU( JZ) , ZMUT( JZ) , ZK( JZ) 

COMMON  /COORD/  SAIX ( I Z , JZ ) , SAI Y( IZ , JZ ) , ETAX ( I Z , JZ ) , 

>  ETAY( IZ, JZ) ,RJ( IZ, JZ) ,X(IZ, JZ),Y(IZ, JZ) , 

>  DELTAU ( I Z , JZ ) , A1 ( I Z , JZ ) , A2 ( IZ , JZ ) , A3 ( I Z , JZ ) , 

>  A4(IZ,JZ) 

COMMON  /CONS/  EXI , EYI , THETA, CFL, CFLl , OMEGAX, OMEGAY, AIN, AEX, 
RL , RG , AMWO , GAMMAO , REN , PRN , PRNT , TREF , ZMUO , OMEGA , 

>  P0,T0,TWALL,PB,SUM(4) 

COMMON  /INTEG/  I L , JL , I LI , JLl , NBEG, NEND, NADV, NORD, ITIME , 

>  IVISC, IWALL, IWRT 

DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ) ,RHOV( IZ , JZ ) , EO ( IZ , JZ ) 
EQUIVALENCE  (Q( 1 , 1, 1 ) , RHO( 1, 1) ) , (Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(l, 1,3),RH0V(1,1)), (Q(1,1,4),E0(1,1)) 
DIMENSION  ADD(4) 

***************************************************************** 
ENTRY  ADDX 

**************************************************************** 

* 

*  ADD  SAI-DIRECTION  4TH  ORDER  ARTIFICIAL  VISCOSITY 

* 

COEF-0. 1250*OMEGAX 

DO  70  J-=1,JL 

DO  70  1=1, IL 

DO  70  1=2, I L 

IF( I . EQ. 1 )  GO  TO  10 

IF( I . EQ. 2  )  GO  TO  20 

IF( I . EQ. ILl )  GO  TO  30 
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IF( I . EQ. IL)  GO  TO  40 
DO  5  K-=l,4 

5  ADD(K)=COEF*(Q( I+2,J,K)-4.*Q(I+1,J,K) 

>  +6.*Q(I, J,K)-4.*Q(I-1, J,K) 

>  +Q(I-2,J,K)) 

GO  TO  50 

10  DO  15  K=l,4 

QM=2.*Q(1, J,K)-Q(2, J,K) 

QMM=2. *QM-Q(1, J,K) 

15  ADD(K)=COEF*(Q( 1+2, J,K)-4. *Q( I+l, J,K) 

>  +6.*Q(I, J,K)-4.*QM+QMM) 

GO  TO  50 

20  DO  25  K=l,4 

QMM=2.*Q(1, J,K)-Q(2, J,K) 

25  ADD(K)-COEF*(Q( 1+2, J,K)-4. *Q( I+l, J,K) 

>  +6.*Q(I, J,K)-4.*Q(I-1, J,K) 

■>  +QMM) 

GO  TO  50 
30  DO  35  K=l,4 

QPP=2.*Q(I+1, J,K)-Q(I, J,K) 

35  ADD(K)=COEF*(QPP-4. *Q( I+l, J,K)+6.*Q(I, J,K) 

>  -4.*Q(I-1, J,K)+Q(I-2, J,K) 

) 

GO  TO  50 
40  DO  45  K=l,4 

QP=2.*Q(I, J,K)-Q(I-1, J,K) 

QPP=2.*QP-Q(I, J,K) 

45  ADD{K)=COEF*(QPP-4.*QP+6. *Q( I, J,K)-4.* 

>  Q(I-1, J,K)+Q(I-2, J,K)) 

50  CONTINUE 

DO  60  K=l,4 

60  DQ(I, J,K)=D9( I, J,K)-ADD(K)/RJ(I, J)*Y(I, J) 


70  CONTINUE 
RETURN 


* 

*  ADD  ETA-DIRECTION  4TH  ORDER  ARTIFICIAL  VISCOSITY 

★ 


COEF--=0. 1250*OMEGAY 
DO  170  1=1, IL 
DO  170  1=2, IL 
DO  170  J=1,JL 
IF( J.EQ. 1)  GO  TO  110 
IF(J.EQ.2)  GO  TO  120 
IF(J.EQ.JLl)  GO  TO  130 
IF(J.EQ.JL)  GO  TO  140 
DO  105  K=l,4 

105  ADD(K)=COEF*(Q( I, J+2,K)-4. *Q( I, J+1,K) 

>  +6.*Q(I, J,K)-4.*Q(I, J-1,K) 

>  +Q(I,J-2,K)) 

GO  TO  150 

110  DO  115  K=l,4 

QM=2.*Q( I, 1,K)-Q(I,2,K) 
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QMM=2 . *QM-Q( I , 1, K) 

115  ADD(K)=COEF*(Q(I, J+2,K)-4.*Q(I, J+1,K) 

>  +6.*Q(I, J,K)-4.*QM+QMM) 

GO  TO  150 

120  DO  125  K=l,4 

9MM=2.*Q(I, 1,K)-Q(I,2,K) 

125  ADD(K)=COEF*(Q( I , J+2 , K ) -4 . *Q ( I , J+1 , K ) 

>  +6.*Q(I, J,K)-4.*Q(I, J-1,K) 

>  +QMM) 

GO  TO  150 

130  DO  135  K=l,4 

QPP=2.*Q(I, J+1,K)-Q(I, J,K) 

135  ADD(K)=COEF*(QPP-4. *Q( I, J+1,K)+6.*Q(I, J,K) 

>  -4.*Q(I, J-1,K)+Q(I, J-2,K) 

>  ) 

GO  TO  150 
140  DO  145  K=l,4 

QP-2.*Q(I, J,K)-Q(I, J-1,K) 

QPP=2.*QP-Q{I, J,K) 

145  ADD(K)=COEF*(QPP-4.*QP+6.*Q( I , J,K)-4.* 

>  Q(I,J-1,K)+Q(I, J-2,K)) 

150  CONTINUE 

DO  160  K=l,4 

160  DQ( I, J,K)=DQ(I, J,K)-ADD(K)/RJ(I, J)*Y(I, J) 

170  CONTINUE 
RETURN 
END 

SUBROUTINE  UGAS3 (E, RHO, ZMU) 

INPUTS  FOR  SUBROUTINE  : 

E  =  SPECIFIC  INTERNAL  ENERGY,  IN  (M/S)**2 
RHO  DENSITY,  IN  KG/M**3 

OUTPUT  : 

ZMU  =  DYNAMIC  VISCOSITY,  IN  KG/M/S 

DATA  RHO0,E0/1.243,78408.4E00/ 

Z=ALOG10(E/E0) 

Y=ALOG10 ( RHO/RHOO ) 

IF  (Z.GT.O. 67E00)  GO  TO  10 

GAS1=4.84547E-01+4.67135E-01*Z 

GAS2^(5 . 71205E-04-1 . 43629E-03*Z ) *Y 

GAS3=(2 . 55110E00-2 .33472E-04*Y-1.44102E00*Z)*Z*Z 

GAS4=(2 . 53416E-04-4. 72375E-04*Z+1 .86899E-05*Y)*Y*Y 

F=GAS1 +GAS2  +GAS3  +GAS4 

GO  TO  90 

10  IF  (Z.GT. 1 . 75E00)  GO  TO  20 
GASl=-3 . 71666E01+6. 67883E01*Z 
GAS2=(-2 . 43998E00+2 . 12309E00*Z ) *Y 

GAS3=( -3 . 69259E01-3 .08426E-01*Y+7.36486E00*Z)*Z*Z 
GAS4=( -1 . 46446E-01+7 . 54423E-02*Z-2 . 91464E-03*Y) *Y*Y 
GAS5=3.61757E01-6. 11102E01*Z 
GAS6=(2 . 40531E00-2 .05914E00*Z)*Y 
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GAS7=(3 . 23911E01+2 . 79149E-01*Y-5 . 07640E00*Z ) *Z*Z 
GAS8=( 1 . 37916E-01-6 . 72041E-02*Z+2 . 61987E-03*Y) *Y*Y 
GAS9=EXP ( -3 . 433E01- 1 . a23E00*Y+2 . 499E01*Z+6 . 503E-01*Z*Y) 
GO  TO  80 

20  IF  (Z.GT. 2 . 50E00)  GO  TO  30 
GAS1=-1 . 65147E02+2 . 11028E02*Z 
GAS2=(-4. 70948E00+2 . 78258E00*Z ) *Y 

GAS3=(-8. 78308E01-1 .28671E-01*Y+1.27639E01*Z)*Z*Z 
GAS4=(-3 . 19867E-01+1 . 73 179E-01*Z+3 . 86106E-03* Y ) *Y*Y 
GAS5=2 . 30407E02-2 . 98055E02*Z 
GAS6=(-6. 18307E00+8.44595E00*Z)*Y 
GAS7=( 1 . 26933E02-2 . 6167 lEOO* Y- 1 . 77257E01*Z ) *Z*Z 
GAS8=( -2 . 30229E-02+2 . 25458E-02*Z-4. 41072E-03*Y) *Y*Y 
GAS9=EXP ( -6 . 882E01+8 . 824E00*Y+3 . 203E01*Z-5 . 359E00*Z*Y) 
GO  TO  80 

30  IF  (Z.GT.2 .85E00)  GO  TO  40 
GASl=-7.09274E03+7. 1364aE03*Z 
GAS2=(-2 .46014E02+1 . 65826E02*Z ) *Y 

GAS3=(-2 .37952E03-2 . 75487E01*Y+2 . 63465E02 *Z ) *Z*Z 

GAS4=(-3 . 49744E00+1 .28641E00*Z-3. 13711E-03*Y)*Y*Y 

GAS5=5 .26158E03-4.96701E03*Z 

GAS6=(2 .03138E02-1 . 32984E02*Z ) *Y 

GAS7=( 1 . 52424E03+2 . 15081E01*Y-1 . 50450E02*Z ) *Z*Z 

GAS8=(3 . 32432E00-1 . 15997E00*Z+1 . 14862E-02*Y) *Y*Y 

GAS9=EXP( -3 . 594E02-3 . 763E01*Y+1 . 319E02*Z+1 . 348E01*Z*Y) 

F=GAS1+GAS2+GAS3+GAS4 

GO  TO  80 

40  IF  (Z.GT.3.15E00)  GO  TO  50 
GAS1=-1 .27748E03+1.29400E03*Z 
GAS2=( -3 . 60724E01+2 . 63194E01*Z)*Y 
GAS3=(-4.22958E02-4.38228E0O*Y+4.5O571EOl*Z)*Z*Z 
GAS4=(-4. 74425E-01+2 . 89684E-01*Z+1 . 64048E-02*Y) *Y*Y 
F=GAS 1 +  GAS2  +GAS3  +GAS4 
GO  TO  90 

50  IF  (Y.GT.-3.80E00)  GO  TO  70 
IF  (Z.GT. 3 . 19E00)  GO  TO  60 
GAS1=4. 55919E03-4.21057E03*Z 
GAS2=( 1 .03001E01-2 . 63478E01*Z ) *Y 
GAS3=( 1 .29069E03+6. 59587E00*Y-1.31413E02*Z)*Z*Z 
GAS4^(-8.28137E00+1 .9827E00*Z-1 . 7287E-01*Y ) *Y*Y 
F=GAS1+GAS2+GAS3+GAS4 
GO  TO  90 
60  Z^E/EO 

GASl=-4. 41792E02+9. 7986E-02*Z 
GAS2=(-3 .03148E02+7. 6065E-03*Z)*Y 

GAS3^(-5. 5711E-05-3 . 52836E-06*Y+8 . 86148E-09*Z ) *Z*Z 
GAS4=(-7 . 561E01-4. 76816E-04*Z-6.48859E00*Y)*Y*Y 
GAS5^6. 72387E04+3 . 28398E00*Z 
GAS6=(3 . 55009E04+2 . 72616E00*Z ) *Y 

GAS7=(2 . 13714E-03+3 . 42377E-04*Y-6 . 84897E-08*Z ) *Z*Z 
GAS8=( 6 . 50886E03+3 . 8056E-01*Z+4 . 14116E02*Y ) *Y*Y 
GAS9=EXP( 2 . 978E01+5 . 415E00*Y+1 . 713E-03*Z+3 . 115E-04*Y*Z ) 
F=GASl+GAS2+GAS3+GAS4+(GAS5+GAS6+GAS7+GAS8)/( 1 .0-GAS9) 
GO  TO  90 

70  GASl^-6. 4029E03+6.24254E03*Z 
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GAS2:=(  1 . 032  79E02-8. 73181E01*Z)*Y 

GAS3=(-2 .02865E03+1 . 7 1878E01*Y+2 . 19907E02*Z ) *Z*Z 
GAS4=(-1 . 22397E01+3 . 57830E00*Z-1 . 27953E-01*Y) *Y*Y 
F=GAS1 +GAS2  +GAS3  +GAS4 
GO  TO  90 

80  F-GASl +GAS2  +  GAS3  +GAS4+ ( GAS5+GAS6+GAS7+GAS8 )/( 1 . 0+GAS9 ) 

90  ZMU=1 . 748583E-05*F 
RETURN 
END 

SUBROUTINE  UGAS4 ( E , RHO , ZK ) 

INPUTS  FOR  SUBROUTINE  : 

E  ^  SPECIFIC  INTERNAL  ENERGY,  IN  (M/S)**2 
RHO  DENSITY,  IN  KG/M* *3 

OUTPUT  : 

ZK  =  COEFFICIENT  OF  THERMI^L  CONDUCTIVITY,  IN  J/(KELVIN*M*S ) 

DATA  RHOO, EO/1 . 243E00, 78408E00/ 

Z=ALOG10(E/E0) 

Y= ALOGl 0 ( RHO /RHOO ) 

IF  (Z.GT.0.65E00)  GO  TO  10 

GAS1=1 . 8100369E-01+4. 8126802E00*Z 

GAS2=(-2 . 7231116E-02+1 . 2691337E-01*Z)*Y 

GAS3=( -8 . 9913034E00- 1 . 2624085E-01*Y+8 . 9649105E00*Z ) *Z*Z 

GAS4=( -4. 719S236E-03+9 . 2328079E-03*Z-2 . 9488327E-04*Y) *Y*Y 

F=GAS  1  +GAS2  +GAS3  -f'GAS4 

GO  TO  200 

10  IF  (Y.GT.-l.OOEOO)  GO  TO  130 
IF  (Y.GT. -3 .OOEOO)  GO  TO  70 
IF  (Z.GT. 1 , 25E00)  GO  TO  20 
GAS1^--1 . 05935E04  +  2 . 31470E04*Z 
GAS2=( -7 . 41294E02+1 . 21724E03*Z)*Y 
GAS3-(-l . 67601E04-4. 43184E02*Y+4.06631E03*Z)*Z*Z 
GAS4=( 1 . 35105E01+4.94914E00*Z+1 .55386E00*Y)*Y*Y 
GAS5:=1 . 06032E04-2 . 31560E04*Z 
GAS6=^(7 . 46951E02-1 . 22465E03 *Z )  *Y 

GAS7^( 1 . 67604E04+4. 45919E02*Y-4.06258E03*Z)*Z*Z 
GAS8=(-1 . 28615E01-5. 32398E00*Z-1.52956E00*Y)*Y*Y 
GAS9=EXP(-4. 219E01-4. 687E00*Y+2.812E01*Z+3 . 125E00*Y*Z) 
F^GASl  +  GAS2  +GAS3+GAS4+ ( GAS5+GAS6+GAS7+GAS8 )/( 1 . 0-GAS9 ) 

GO  TO  200 

20  IF  (Z.GT. 1 . 775EOO)  GO  TO  30 
GAS1=3 . 79375E03-7. 40351E03*Z 
GAS2=^(3 . 296g8E02-3 . 55916E02*Z  )  *Y 

GAS3^(4. 77122E03+1 .00241E02*Y-1 .00740E03*Z)*Z*Z 
GAS4^( 1 . 97061E01-8. 42554E00*Z+4.80494E-01*Y)*Y*Y 
GAS5  =  -4. 53603E03  ^9 . 05605E03*Z 
GAS6=^(  -4. 95870E02  +  6. 33563E02*Z)*Y 

GAS7=(-5 .95317E03-2 .05442E02*Y+1.28945E03*Z)*Z*Z 
GASS- ( -2 . 00087E01+1 . 18851E01*Z-1 . 71735E-01*Y) *Y*Y 
GAS9-EXP(-3 . 3I8E01+3. 1 58E-01*Y+1 . 863E01*Z- 1 . 035E00*Y*Z ) 

GO  TO  190 
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30  IF  (Z.GT. 1 .93E00)  GO  TO  40 

GAS1=2 . 06651875E05-3 . 165645E05*Z 
GAS2= (-3. 0732202 1E02+4. 57036377E02*Z)*y 

GAS3=( 1 . 61824937E05-1 . 55508453E02*Y-2 . 7603957E04*Z ) *Z*Z 
GAS4=( 1 . 922602&5E00-2 . 24788094E00*Z-3 . 06226015E-01 *Y ) *Y*Y 
GAS5=-2 .06564312E05+3 . 18191312E05*Z 
GAS6=(2 . 17542285E03-2 . 46670776E03*Z ) *Y 

GAS7=(-1.63597062E05+7 . 16753 174E02*Y+2 . 80926367E04*Z ) *Z*Z 
GAS8=( 3 . 39526825E01-7 . 338  :6645E00*Z+1 . 91214371E00*Y) *Y*Y 
GAS9=EXP( -3 . 924E02-5 . 206E01*Y+2 . 054E02*Z+2 . 679E01*Y*Z) 

GO  TO  190 

40  IF  (Z.GT.2.60E00)  GO  TO  50 

GAS 1=7 . 1572625E04-9.2471625E04*Z 
GAS2=( 1 . 9646323E03-2 . 0280527E03*Z ) *Y 

GAS3=(3 . 9446105E04+4. 5673853E02*Y-5. 5728672E03*Z)*Z*Z 
GAS4=(-9.2131958E01+1.2724541E01*Z-5.0568476E00*Y)*Y*Y 
GAS5=-3 .2910781£04+4.2551211E04*Z 
GAS6=( 1 . 456633 1E03 -2 . 2653745E03*Z ) *Y 

GAS7={-1 .9476277E04+8.4370288E02*Y+3 .2389702E03*Z)*Z*Z 
GAS8=( -1 . 3324594E02+1 . 0591533E02*Z+5 . 8639469E00*Y) *Y*Y 
GAS9=EXP(4. 917E01+2 . 415E01*Y-2 . 455E01*Z-1 . 181E01*Y*Z) 

GO  TO  190 

50  IF  {Z.GT.2.69E00)  GO  TO  60 

GAS1=1. 145683E06-1.237525E06*Z 
GAS2=( 1 . 4024508E04-9 . 3467227E03*Z) *Y 

GAS3=(4.4593056E05+1.533074E03*Y~5.3608352E04*Z)*Z*Z 
GAS4=(2 . 8485107E02-1 . 09689 16E02*2- 1 . 0955791E00*Y ) *Y*Y 
GAS5=-1 . 752087E06+1 . 79675E06*Z 
GAS6=(-1 . 3278737E05+9.8215562E04*Z)*Y 

GAS7=( -6. 0791744E05-1 . 81 1943E04*Y+6 . 7709875E04*Z) *Z*Z 
GAS8=( -1 . 3384084E03+5 . 2707324E02*Z+2 . 5904894E00*Y) *Y*Y 
GAS9=EXP( -1 . 798E02+7 . 371E00*Y+6 . 731E01*Z-3 . 205E00*Y*Z) 

GO  TO  190 

60  GASl=-8. 5499625E04+1 . 1739656E05*Z 
GAS2=(6. 4563168E04-3 .9551203E04*Z)*Y 

GAS3=( -4 . 8170254E04+6 . 0816055E03*Y+6 . 205203 1E03*Z ) *Z*Z 
GAS4=(2 .3473167E-01+1.8871567E01*Z+4.0757723E00*Y)*Y*Y 
GAS5=5 . 8546883E04-9 . 4634875E04*Z 
GAS6=(-6.6513812E04+4.0899945E04*Z)*Y 

GAS7=(4.2127227E04-6. 3717305E03*Y-5. 7495195E03*Z)*Z*Z 
GAS8=( -1 . 0260344E00-5 . 343277E01*Z-1 . 1017392E01*Y ) *Y*Y 
GAS9=EXP( 5 . 411E00+1 . 162E01*Y-1 . O82EO0*Z-3 . 391E00*Y*Z) 
F=GAS1+GAS2+GAS3+GAS4+(GAS5+GAS6+GAS7+GAS6)/( 1 .0-GAS9) 

GO  TO  200 

70  IF  (Z.GT. 1 .29E00)  GO  TO  80 
GAS1=-1 . 22493E04+2 . 41071E04*Z 
GAS2=(-1. 61829E03+2 .22535E03*Z)*Y 
GAS3=( -1 . 59261E04-7 . 53213E02*Y+3 . 53376E03*Z ) *Z*Z 
GAS4=( 1 . 98026E00+5 . 18483E00*Z+ 1 . 47851E00*Y) *Y*Y 
GAS5=1 . 22486E04-2 . 41023E04*Z 
GAS6=( 1 . 61810E03-2 . 22571E03*Z ) *Y 
GAS7=( 1 . 59235E04+7 . 53746E02*Y-3 . 53168E03*Z ) *Z*Z 
GAS8=( -2 . 15482E00-5 . 05115E00*Z-1 . 48795E00*Y) *Y*Y 
GAS9=EXP { -3 . 1 1 lEOl-4 . 444E00*Y+ 1 . 944E01*Z+2 . 778E00*Y*Z ) 
F=GAS1+GAS2+GAS3+GAS4+ (GAS5+GAS6+GAS7+GAS8)/( 1 . 0-GAS9 ) 
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GO  TO  200 

80  IF  (Z.GT. i .85E00)  GO  TO  90 
GAS1=3 . 18060E03-6 , 69664E03*Z 
GAS2^(4.33382E0  1-:',  .  14649E02*Z  )  *Y 

GAS3^( 4. 413  77E03  <  9 . 413  59E01*Y-9 . 29758E02*Z) *Z*Z 
GAS4^( -3 . 62190E01+] . 15538E01*Z-2 . 14621E00*Y) *Y*Y 
GAS5=-5 . 98764E03  *  1 . 29243E04*Z 
GAS6=(-2 . 72261E02+5. 42378E02*Z)*Y 
GAS7=(-9 . 03293E03-2 . 11787E02*Y+2 . 07831E03*Z) *Z*Z 
GAS8=(2 . 74179E01-5 . 68578E00*Z+1 . 91217E00*Y) *Y*Y 
GAS9=EXP(-1 . 854E01+7 . 1 1E00*Y+1 . 068E01*Z-5 . 449E00*Y*Z ) 
GO  TO  190 

90  IF  (Z  GT.2.0E00)  GO  TO  100 
GAS1=5 . 14024E04-7 . 52733E04*Z 
GAS2=( -3 . 30889E02+3 . 1 1550E02*Z ) *Y 
GAS3=(3 . 66539E04-7. 41227E01*Y-5.93015E03*Z)*Z*Z 
GAS4=^(  -4. 84164E01  +  2 . 23  133E01*Z-9 . 19118E-01*Y)  *Y*Y 
GAS5=-1 . 80898E05+2 . 82532E05*Z 
GAS6-=(  -1 . 01053E03  +  9 . 75576E02*Z)  *Y 

GAS7=( -1 . 47220E05-2 . 33631E02*Y+2 . 55940E04*Z ) *Z*Z 
GAS8=^(  3 . 28681E00-  1 . 76588E00*Z-1 . 54962E-01*Y )  *Y*Y 
G.^''«-^EXP(  -4  1  ':^'iEGl  +  6 . 5C7EGl*Y+2 . 083E01*Z-3 . 472E01*Z*Y) 
GO  TO  190 

100  IF  (Z.GT.2 . 58E00)  GO  TO  110 

GASl^S. 1131824E04-6. 664875E04*Z 
GAS2=(2 .02171E03-1 .9306292E03*Z)*Y 

GAS3=(2 .8762395E04+4.3353467E02*Y-4.10646C9E03*Z)*Z*Z 
GAS4=:(-8.4970047E01  +  1 . 7925919E01*Z-6 . 2576542E00*Y)  *Y*Y 
GAS5=-6.2768156E04^8. 6015875E04*Z 
GAS6-(-l . 000203 6E03+6. 2537280E02*Z)*Y 
GAS7=(-3 .957827E04-3 .8467377E01*Y+6. 12953E03*Z)*Z*Z 
GAS8=(-1 .0591702E02+7 . 636142E01*Z+5 . 938859E00*Y) *Y*Y 
GAS9=EXP( -3 . 901E0042 . ^18E01*Y+1 . 374E00*Z-1 . 145E01*Y*Z) 
GO  TO  190 

110  IF  (Z.GT. 2 . 73E00)  GO  TO  120 

GAS1=1 . 0088046E06-1 . 086321E06*Z 
GAS2=( 1 . 3844801E04-g. 72685 16E03*Z)*'' 

GAS3=( 3 . 8985325E05+1 . 709 1665E03*Y-4 . 662 1066E04*Z ) *Z*Z 
GAS4^( 1 . 4840726E02-5 . 2645004E01*Z-1 . 5477133E-01*Y) *Y*Y 
GAS5=^-1 . 0733  51E06^1 .  14571E06*Z 
GAS6=( -1 . 9343957E04+1 . 33662 11E04*Z) *Y 

GAS7-( -4. 0670987E05-2 . 2965 198E03*Y+4 . 7999871E04*Z ) *Z*Z 
GAS8^(-4. 1016724E02+1 . 49g4148E02 *Z-1 . 9779787E00*Y ) *Y*Y 
GAS9-EXP( -1 . 026E02+6 . 302E01*Y+3 . 819E01*Z-2 . 431E01*Y*Z) 
GO  TO  190 

120  GASl=-9 . 6638500E04+ 1 . 3206488E04*Z 

GAS2^(-4. 7458105E04+2 . 3 596875E04*Z ) *Y 

GAS3=( 1 . 8602773E04-2 . 306802E03 *Y-4 . 0413552E03*Z ) *Z*Z 

GAS4=( -5 . 3564258E03+2 . 2433904E03*Z+2 . 5188145E02*Y) *Y*Y 

GAS5=1 . 0962581E03-2 . 9g0116E04*Z 

GAS6=(4. 7883496E04-2 . 3785383E04*Z ) *Y 

GAS7-(-l . 1753969E04+2 . 2905522E03*Y+3 . 1304399E03*Z ) *Z*Z 
GAS8---(  5 . 473418E03-2 . 3208018E03*Z-2 . 6570068E02*Y)  *Y*Y 
GA39-EXP ( -3 . 107E01 f 1 . 082E01*Y+1 . 047E01*Z-3 . 047E00*Y*Z ) 
F^GAS1+GAS2+GAS3  t-GAS4+ ( GAS5+GAS6+GAS7+GAS8  )/( 1 .0-GAS9) 
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GO  TO  200 

130  IF  (Z.GT. 1 . 40E00)  GO  TO  140 
GAS1=-1 . 58386E03+3 . 49223E03*Z 
GAS2=( -8 . 39834E02+1 . 09565E03*Z ) *Y 
GAS3=(-2 . 56175E03-3 . 56197E02*Y+6 . 25145E02*Z ) *Z*Z 
GAS4=(-1 . 22407E01+7 . 65634E00*Z+2 . 58235E-01*Y) *Y*Y 
GAS5=1 . 58025E03-3 . 47664E03*Z 
GAS6=(8. 39588E02-1 .09490E03*Z)*Y 
GAS7=(2 . 54682E03+3 . 55674E02*Y-6 . 18504E02*Z ) *Z*Z 
GAS8=( 1 . 20843E01-7 . 44857E00*Z-2 . 91202E-01*Y) *Y*Y 
GAS9=EXP( -2 . 171E01-4. 342E00*Y+1 . 316E01*Z+2 . 632E00*Y*Z) 
F=GAS1+GAS2+GAS3+GAS4+ (GAS5+GAS6+GAS7+GAS8)/( 1 . 0-GAS9) 
GO  TO  200 

140  IF  (Z.GT. 1 . 91E00)  GO  TO  150 
GAS1=7 . 89255E02-1 . 91743E03*Z 
GAS2=(3 . 59227E02-4. 44070E02*Z)*Y 
GAS3=( 1 . 39463E03+1 . 34083E02*Y-3 . 13446E02*Z ) *Z*Z 
GAS4=( 1 .90681E01-1 .09285E01*Zf4. 24933E-02*Y)*Y*Y 
GAS5-^-1.31401E03  +  3. 13134E03*Z 
GAS6=(-5. 18755E02+6.80268E02*Z)*Y 
GAS7=(  -2 . 32493E03-2 . 21393E02’^Y+5 . 52563E02*Z )  *Z*Z 
GAS8=(-3 . 32001E01+2 . 1 1819E01*Z-4 . 75163E-01*Y ) *Y*Y 
GAS9=EXP( -5 . 025E01-8. 412E00*Y+2 . 982E01*Z+3 . 509E00*Y*Z) 
GO  TO  190 

150  IF  (Z.GT.2 .05E00)  GO  TO  160 
GAS1=3 . 58691E04-5 . 16852E04*2 
GAS2=(-6.30189E02+6.63314E02*Z)*Y 
GAS3=( 2 . 47471E04-1 . 73538E02*Y-3 . 93167E03*Z ) *Z*Z 
GAS4^(-4.23871E01+2 .08048E01*Z-1.05512E00*Y)*Y*Y 
GAS5=-1 . 10522E05+1 . 67591E05*Z 
GAS6=(4.61877E03-4.94930E03*Z)*Y 

GAS7=( -8 . 46558E04+1 . 32441E03*Y+1 . 42438E04*Z ) *Z*Z 
GAS8=(2 .25065E01-1 . 103 16E01*Z+9 . 62887E-01*Y ) *Y*Y 
GAS9-=EXP(  -1 . 681E02  +  7 . 063E01*Y+8 . 75E01*Z-3 . 75E01*Y*Z  ) 

GO  TO  190 

160  IF  (Z.GT.2 . 57E00)  GO  TO  170 

GAS1=3 . 1899562E04-4.2186664E04*Z 
GAS2=(2 . 3055603E03-1.9897017E03*Z)*Y 

GAS3=( 1 .849g98E04+4.2561816E02*Y-2. 6808696E03*Z)*Z*Z 
GAS4=( -1 . 6195114E01+5 . 8640623E00*Z-3 . 6172504E00*Y) *Y*Y 
GAS5=-5 . 7594039E04+7 . 9328437E04*Z 
GAS6=(-1 . 9275989E03+1 . 6730544E03*Z ) *Y 

GAS7=(-3 . 6473008E04-3 . 6100732E02*Y+5 . 597543E03*Z ) *Z*Z 
GAS8=(-7 .920808E01+4.0542084E01*Z+2 . 1495867E00*Y) *Y* Y 
GAS9=EXP( -5 . 733E01+2 . 088E01*Y+2 . 592E01*Z-9 . 793E00*Y*Z) 
GO  TO  190 

170  IF  (Z.GT.2. 75EOO)  GO  TO  180 

GAS1=7. 0838087E05-7. 5619919E05*Z 

GAS2=(3 .9503091E03-2 . 7381802E03*Z) *Y 

GAS3=(2 . 6888181E05+4. 7728687E02*Y-3 . 183816E04*Z ) *Z*Z 

GAS4=(-1.2532251E02+4.7734787E01*Z-4.0148029E00*Y)*Y*Y 

GAS5=-2 . 5216325E05+2 . 1727769E05*Z 

GAS6=(9.2882383E03-7 . 780918E03*Z ) *Y 

GAS7^( -5 . 6539297E04+1 . 61 202 12E03*Y+3 . 9419248E03*Z ) *Z*Z 
GAS8-(1 .8537296E02-7. 1010757E01*Z+1 . 1307096E00*Y) *Y*Y 
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GAS9^EXP( -1 . 786E02+2 . 18E-01*Y+6 . 7l4E01*Z-4 . 739E-01*Y*Z ) 

GO  TO  190 

180  GASl^l . 1855037E05-3 . 3041156E05*Z 

GAS2-(2 . 2983352E04-1 . 6623461E04*Z ) *Y 

GAS3-( 1 . 13848E05+3 .0098223E03*Y-1.3020133E04*Z)*Z*Z 

GAS4--^(  -1 . 8599039E02  +  6 . 9840683E01*Z-7 . 7371645E00*Y)  *Y*Y 

F^GASl  t-GAS2+GAS3+GAS4 

GO  TO  200 

190  F=GAS1+GAS2+GAS3+GAS4+ (GAS5+GAS6+GAS7+GAS8)/( 1 . 0+GAS9) 

200  ZK=1 . 87915E-02*F 
RETURN 
END 

FUNCTION  FAMW(R,T) 

COMMON  /INPL/  Xl(9) , Yl(9) , Fl(9,9) ,X2(9) ,Y2(9) ,F2(9,9) , 

>  X3(9) ,Y3(9),F3(9,9),X4{9),Y4(9),F4(9,9), 

>  X5(9),Y5{9) ,F5(9,9),X6(9),Y6(9),F6(9,9), 

>  X7(9) ,Y7(9) ,F7(9,9) 

IF(R.LT.X1(1) )  11=1 
IF(R.GT.X1(9) )  11=8 

DO  1  1=1,8 

IF(R.GE.X1( I ) .AND.R.LE.X1( I+l) )  THEN 
II  =  I 
GO  TO  2 
ELSE 
END  IF 

1  CONTINUE 

2  CONTINUE 
IF(II.EQ.O)  THEN 

WRITE  (6,500)  R,X1(1),X1(9) 

500  FORMAT ( //2X, 'R  IS  OUT  OF  BOUNDARIES,  CALLED  FROM  FAMW' / 

>  2X, 'R=' ,E12.5,2X, 'Xl(l)=' ,E12.5,2X, 'XI (9)=' ,E12.5) 

STOP 

ELSE 
END  IF 

IF(T. LT. Yl( 1) )  JJ=1 
IF(T.GT. Yl(8) )  JJ=8 
DO  3  J=l,8 

IF(T.GE.Y1( J) .AND.T.LE.Y1( J+1) )  THEN 
JJ=J 
GO  TO  4 
ELSE 
END  IF 

3  CONTINUE 

4  CONTINUE 
IF(JJ.EQ.O)  THEN 

WRITE  (6,501)  T,Y1( 1) , Yl(9) 

501  FORMAT ( //2X, 'T  IS  OUT  OF  BOUNDARIES,  CALLED  FROM  FAMW'/ 

>  2X, 'T=' ,E12.5,2X, 'Yl(l)=' ,E12.5,2X, 'Yl(9)=' ,E12.5) 

STOP 
ELSE 
END  IF 
I  =  I  I 
J=JJ 

IF(TI.EQ.O)  1=11+1 
IF(II.EQ.8)  1=11-1 
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IF(JJ.EQ.O)  J=JJ+1 
IF(JJ.EQ.8)  J=JJ-1 
AMW1=F1( I , J) 

>  ME’M  I  +  l,  J)-F1(  I,  J)  )/(Xl(  I  +  1)-X1(  I  )  )*(R-X1(I  )  ) 
AMW2=F1(I, J'l) 

+( Fl( I+l, J+1)-F1( I , J+1 ) )/{Xl( I+1)-X1( I ) )*(R-X1( I ) ) 
AMW=AMW1+(AMW2-AMW1)/(Y1( J+1)-Y1( J) )*(T-Y1( J) ) 

FAMW=AMW 

RETURN 

END 

FUNCTION  FE(R,T) 

COMMON  /INPL/  X1(9),Y1(9),F1(9,9),X2(9),Y2(9),F2(9,9), 

>  X3 ( 9 ) , Y3 ( 9 ) , F3 ( 9 , 9 ) , X4 ( 9 ) , Y4 { 9 ) , F4 ( 9 , 9 ) , 

>  X5(9),Y5(9),F5(9,9),X6{9),Y6{9),F6(9,9), 

>  X7(9) , Y7(9) ,F7(9,9) 

IF(R. LT.X4( 1) )  11=0 
IF(R.GT.X4(9) )  11=8 

DO  1  1=1,8 

I F ( R . GE . X4 ( I ) . AND . R . LE . X4 ( I + 1 ) )  THEN 
II  =  I 
GO  TO  2 
Fr,SE 
END  IF 

1  CONTINUE 

2  CONTINUE 
IF(II.EQ.O)  THEN 

WRITE  (6,500)  R,X4(1) ,X4(9) 

500  FORMAT ( //2X, 'R  IS  OUT  OF  BOUNDARIES,  CALLED  FROM  FE'/ 

>  2X, 'R=' ,E12.5,2X, 'X4(l)=' ,E12.5,2X, 'X4(9)=' ,E12.5) 
STOP 

ELSE 
END  IF 

IF(T.LT.Y4(1) )  JJ=0 
IF(T.GT. Y4{9) )  JJ=8 
DO  3  J=l,8 

IF(T.GE. Y4( J) .AND.T.LE.Y4( J+1) )  THEN 
JJ=J 
GO  TO  4 
ELSE 
END  IF 

3  CONTINUE 

4  CONTINUE 
IF(JJ.EQ.O)  THEN 

WRITE  (6,501)  T,Y4(1) ,Y4(9) 

501  FORMAT ( //2X, 'T  IS  OUT  OF  BOUNDARIES,  CALLED  FROM  FE ' / 

>  2X, 'T=’ , E12. 5, 2X, ' Y4( 1 )=' ,E12.5,2X, 'Y4(9)=' ,E12.5) 
STOP 

ELSE 
END  IF 
I  =  II 
J=JJ 

IF(II.EQ.O)  1=11+1 
IF(II.EQ.8)  1=11-1 
IF(JJ.EQ.O)  J=JJ+1 
IF(JJ.EQ.8)  J=JJ-1 
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E1=F4( I , J) 

>  +(F4(I+1, J)-F4{I, J) )/(X4(I+l)-X4(I))*(R-X4(I)) 

IF(E1 .LT.F4(1, J) )  E1=F4(1,J) 

IF(E1.GT.F4(9, J) )  E1=F4(9,J) 

E2=F4(I, J+1) 

>  +(F4(I  +  1,  J+1)-F4(I, J+1) )/(X4(I  +  l)-X4{I) )*(R-X4(I)) 
IF(E2.LT.F4(1, J+1) )  E2=F4(1,J+1) 

IF(E2.GT.F4(9, J+1))  E2=F4(9,J+1) 

E=E1+(E2-E1 )/(Y4( J+1 )-Y4( J) )*(T-Y4( J) ) 

IF(E.LT.F4(I, 1) )  E=F4(I,1) 

IF(E.GT.F4(I,9) )  E=F4(I,9) 

FE=E 

RETURN 

END 

FUNCTION  FT(R,E) 

COMMON  /INPL/  X1(9),Y1(9),F1(9,9),X2(9),Y2(9),F2(9,9), 

>  X3(9) ,Y3(9) ,F3(9,9) ,X4(9) ,Y4(9) ,F4(9,9) , 

>  X5 ( 9 ) , Y5 ( 9 ) , F5 ( 9 , 9 ) , X6 ( 9 ) , Y6 ( 9 ) , F6 ( 9 , 9 ) , 

>  X7(9),Y7(9),F7(9,9) 

IF(R.LT.X5(1) )  11=0 
IF(R.GT.X5(9) )  11=8 

DO  1  1=1,8 

I F ( R . GE . X5 ( I ) . AND . R . LE . X5 ( I + 1 ) )  THEN 
I  I  =  I 
GO  TO  2 
ELSE 
END  IF 

1  CONTINUE 

2  CONTINUE 
IF(II.EQ.O)  THEN 

WRITE  (6,500)  R,X5(1) ,X5(9) 

500  FORMAT ( //2X, 'R  IS  OUT  OF  BOUNDARIES,  CALLED  FROM  FT'/ 

>  2X, 'R=' ,E12.5,2X, 'X5(l)=' ,E12.5,2X, 'X5(9)=' ,E12.5) 
STOP 

ELSE 
END  IF 

IF(E. LT. Y5( 1 ) )  JJ=0 
IF(E.GT.Y5(9) )  JJ=8 
DO  3  J=l,8 

IF(E.GE. Y5( J) . AND.E.LE.Y5( J+1) )  THEN 
JJ=J 
GO  TO  4 
ELSE 
END  IF 

3  CONTINUE 

4  CONTINUE 
IF(JJ.EQ.O)  THEN 

WRITE  (6,501)  E, Y5( 1) , Y5(9) 

501  FORMAT ( //2X, ' E  IS  OUT  OF  BOUNDARIES,  CALLED  FROM  FT'/ 

>  2X, 'E=' ,E12.5,2X, 'Y5(l)=' ,E12.5,2X, ' Y5 ( 9 )= ' , E12 . 5 ) 
STOP 

ELSE 
END  IF 
I  =  I  I 
J=JJ 
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IF(II.EQ.O)  1=11+1 
IF(II.EQ.8)  1=11-1 
IF(JJ.EQ.O)  J=JJ+1 
IF(JJ.EQ.8)  J=JJ-1 
T1=F5( I , J) 

>  +(F5(I+1, J)-F5(I, J))/(X5(I+1)-X5(I))*(R-X5(I)) 

T2=F5(I, J+1) 

>  +(F5( I+l, J+l)-F5( I, J+1) )/(X5( I+l)-X5( I ) )*(R-X5( I ) ) 
T=T1+(T2-T1)/(Y5( J+l)-Y5( J) )*(E-Y5(J) ) 

FT=T 

RETURN 

END 

FUNCTION  FZMU(R,E) 

CALL  UGAS3(E,R,ZMU) 

FZMU=ZMU 

RETURN 

END 

FUNCTION  FZK(R,E) 

CALL  UGAS4(E,R,ZK) 

FZK=ZK 

RETURN 

END 

FUNCTION  FDMDRT(R,T) 

COMMON  /INPL/  X1(9),Y1(9),F1(9,9),X2(9),Y2(9),F2(9,9), 

>  X3 ( 9 ) , Y3 ( 9 ) , F3 ( 9 , 9 ) , X4 ( 9 ) , Y4 ( 9 ) , F4 ( 9 , 9 ) , 

>  X5(9),Y5(9),F5(9,9),X6(9),Y6(9),F6(9,9), 

>  X7(9) ,Y7(9) ,F7(9,9) 

IF(R.LT.X2(1) )  11=0 
IF(R.GT.X2(9) )  11=8 

DO  1  1=1,8 

I F ( R . GE . X2 ( I ) . AND . R . LE . X2 ( I + 1 ) )  THEN 
I  I  =  I 
GO  TO  2 
ELSE 
END  IF 

1  CONTINUE 

2  CONTINUE 

I F ( 1 1 . EQ . 0 )  THEN 

WRITE  (6,500)  R,X2(1) ,X2(9) 

500  FORMAT ( //2X, ' R  IS  OUT  OF  BOUNDARIES,  CALLED  FROM  FDMDRT'/ 

>  2X, 'R=' ,E12.5,2X, 'X2(l)=' ,E12.5,2X, 'X2(9)=' ,E12.5) 

STOP 

ELSE 
END  IF 

rF(T.LT. Y2( 1) )  JJ=0 
IF(T.GT. Y2(9) )  JJ=8 
DO  3  J=l,8 

IF(T.GE. Y2( J) . AND.T.LE.Y2( J+1) )  THEN 
JJ=J 
GO  TO  4 
ELSE 
END  IF 

3  CONTINUE 

4  CONTINUE 
IF{JJ.EQ.O)  THEN 
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WRITE  (6,501)  T, Y2(l) , Y2(9) 

501  FORMAT ( //2X, 'T  IS  OUT  OF  BOUNDARIES,  CALLED  FROM  FDMDRT'/ 

>  2X, 'T=' ,E12.5,2X, 'Y2(l)=' ,E12.5,2X, 'Y2(9)=' ,E12.5) 

STOP 
ELSE 
END  IF 
I  =  I  T 
J-JJ 

TF(II.EQ.O)  I-II+l 
IF(II.EQ.8)  1=11-1 
IF(JJ.EQ.O)  J=JJ+1 
IF(JJ.EQ.8)  J=JJ-1 
DMDRT1=F2 ( I , J) 

>  +(F2(I+1, J)-F2(I, J) )/(X2( I+1)-X2(I) )*(R-X2(I) ) 

DMDRT2  =  F2^  T  ,  J+I  ) 

>  +(F2(I+1, J+1)-F2(I, J+1) )/(X2( I+l)-X2( I ) )*(R-X2( I ) ) 
DMDRT=DMDRT 1 + ( DMDRT2 - DMDRT 1)/(Y2(J+1)-Y2(J))*(T-Y2(J)) 
FDMDRT=DMDRT 

RETURN 

END 

FUNCTION  FDMDTR(R,T) 

COMMON  /INPL/  X1(9),Y1(9),F1(9,9),X2(9),Y2(9),F2(9,9), 

>  X3(9) ,Y3(9) ,F3(9,9),X4(9),Y4(9),F4(9,9) , 

>  X5 ( 9 ) , Y5 ( 9 ) , F5 ( 9 , 9 ) , X6 ( 9 ) , Y6 ( 9 ) , F6 ( 9 , 9  )  , 

X7(9) ,Y7(9) ,F7(9,9) 

IF(R.LT.X3(1) )  11=0 
IF(P .GT.X3(9) )  11=8 
DO  1  1=1,8 

IF(R.GE.X3( I) . AND.R. LE.X3( I+l) )  THEN 
I  I  =  I 
GO  TO  2 
ELSE 
END  IF 

1  CONTINUE 

2  CONTINUE 
IF(II.EQ.O)  THEN 

WRITE  (6,500)  R,X3(1),X3(9) 

500  FORMAT ( //2X, 'R  IS  OUT  OF  BOUNDARIES,  CALLED  FROM  FDMDTR'/ 

>  2X, 'R=’ ,E12.5,2X, ’X3(l)=' ,E12.5,2X, 'X3(9)=' ,E12.5) 

STOP 
ELSE 
END  IF 

IF(T.LT.Y3(1) )  JJ=0 
IF(T.GT. Y3(9) )  JJ=8 
DO  3  J=l,8 

I F ( T . GE . Y3 ( J ) . AND . T . LE . Y3 ( J+ 1 ) )  THEN 
JJ=J 
GO  TO  4 
ELSE 
END  IF 

3  CONTINUE 

4  CONTINUE 
IF(JJ.EQ.O)  THEN 

WRITE  (6,501)  T,Y3(1) ,Y3(9) 

501  FORMAT ( //2X, 'T  IS  OUT  OF  BOUNDARIES,  CALLED  FROM  FDMDTR'/ 
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-  ^A, 'T-’ ,E12.5,2X, 'Y3(l)=' ,E12.5,2X, 'Y3(9)=' ,E12.5) 

STOP 
ELSE 
END  IF 
I^I  I 

IF(II.EQ.O)  1=11+1 
IF(II.EQ.8)  1=11-1 
IF(JJ.EQ.O)  J=JJ+1 
IF(JJ.EQ.8)  J=JJ-1 
DMDTR1=F3 ( I,  J) 

>  +(F3( I+l, J)-F3( 1, J) )/(a3( I+l)-X3( I ) )*(R-X3( I ) ) 

DMDTR2=F3 ( I , J+1 ) 

•  +(F3(I+1, J+1)-F3(I, J+1) )/(X3(I+l)-X3(I) )*(R-X3(I)) 

DMDTR=DMDTP1+ (DMDTR2-DMDTR1 )/( Y3 ( J+1 ) -Y3 ( J ) )*(T-Y3( J) ) 
FDMDTR=DMDTR 
RETURN 
END 

FUNCTION  FDTDRE(R,E) 

COMMON  /INPL/  Xl(9 ) , Yl(9 ) , Fl(9,9) ,X2 (9 ) , Y2 (9) , F2 (9, 9) , 

>  X3(9) ,Y3(9) ,F3(9,9) ,X4(9) ,Y4(9) ,F4(9,9) , 

>  X5(9) , Y5(9) ,F5(9,9) ,X6(9) , Y6(9) ,F6(9,9)  , 

>  X7(9) ,Y7(9) ,F7(9,9) 

IF(R. LT.X6( 1 ) )  11=0 

IF(R.GT.X6(9) )  11=8 

DO  1  1=1,8 

I F ( R . GE . X6 ( I ) . AND . R . LE . X6 ( I + 1 ) )  THEN 
I  I  =  I 
GO  TO  2 
ELSE 
END  IF 

1  CONTINUE 

2  CONTINUE 

I F ( I  I . EQ . 0 )  THEN 

WRITE  (6,500)  R,X6(1) ,X6(9) 

500  F0RMAT(//2X, 'R  IS  OUT  OF  BOUNDARIES,  CALLED  FROM  FDTDRE  / 

>  2X, ’R=' ,E12.5,2X, 'X6(l)=' ,E12.5,2X, ' X6 ( 9 ) = ' , E12 . 5 ) 

STOP 

ELSE 
END  IF 

IF(E.LT.Y6( 1) )  JJ=0 
IF(E.GT.Y6(9) )  JJ=8 
DO  3  J=l,8 

I F ( E . GE . Y6 ( J ) . AND . E . LE . Y6 ( J  + 1 ) )  THEN 
JJ=J 
GO  TO  4 
ELSE 
END  IF 

3  CONTINUE 

4  CONTINUE 
IF(JJ.EQ.O)  THEN 

WRITE  (6,501)  E,Y6(1) ,Y6(9) 

501  FORMAT ( //2X, ' E  IS  OUT  OF  BOUNDARIES,  CALLED  FROM  FDTDRE  / 

>  2X, 'E=' ,E]2.5,2X, ' Y6( 1 )=' , E12 . 5, 2X, ' Y6(9 )=' , E12 . 5 ) 

STOP 
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ELSE 
END  IF 
I-=I  I 

J=--JJ 

IF(II.EQ.O)  1=11+1 
IF(  I  I  .Eg.8)  1  =  11-1 
IF(JJ.EQ.O)  J=JJ+1 
IF(JJ.EQ.8)  J=JJ-1 
DTDRE1=F6( I , J) 

>  +(F6(I+1,J)-F6(I,J) )/(X6( I+l)-X6( I ) )*{R-X6(I) ) 

DTDRE2  =  F6( I , J+1 ) 

>  ^(F6( I+l, J+1)-F6(I, J+1) )/(X6(I+l)-X6(I) )*(R-X6(I) ) 
DTDRE=DTDRE 1 + ( DTDRE2 -DTDRE 1 ) / ( Y6 ( J+ 1 ) -Y6 ( J ) ) * ( E- Y6 ( J ) ) 

FDTDRE=DTDRE 

RETURN 

END 

FUNCTION  FDTDER(R,E) 

COMf'ION  /INPL/  Xl(9),yi(9),Fl(9,9),X2(9),Y2(9),F2(9,9), 

->  X3(9)  ,Y3(9)  ,F3(9,9),X4(9),Y4{9),F4(9,9)  , 

>  X5(9) ,Y5(9) ,F5(9,9),X6(9),Y6(9) ,F6(9,9) , 

>  X7(9) , Y7(9) ,F7(9,9) 

IF(R. LT.X7( 1 ) )  11=0 
IF(P.GT.X7(9) )  11=8 

DO  1  I = ] , 8 

IF{R. GE , X7( I ) . AND. R. LE.X7( I+l) )  THEN 
I  I  =  I 
G(;  'I'O  2 
ELSE 
END  IF 

1  CONTINUE 

2  CONTINUE 

IF( II .EQ.O)  THEN 

WRITE  (6,500)  R,X7(1),X7(9) 

500  FORMAT ( //2X, ' R  IS  OUT  OF  BOUNDARIES,  CALLED  FROM  FDTDER'/ 

>  2X, 'R=' ,E12.5,2X, 'X7(l)=' ,E12.5,2X, ’X7(9)=' ,E12.5) 

STOP 
ELSE 
END  I F 

IF(E.LT.Y7(1) )  JJ=0 
IE(E.G'r.  Y7(9)  )  JJ=8 
DO  3  J-1,8 

I F ( E . GE . Y7 ( J )  . AND . E . LE . Y7 ( J+ 1 )  )  THEN 
J  J  =  J 
GO  TO  4 
ELSE 
END  IF 

3  CONTINUE 

4  CONTINUE 
IF(JJ.EQ.O)  THEN 

WRITE  (6,501)  E, Y7( 1) , Y7(9) 

501  FORMAT ( //2X, 'E  IS  OUT  OF  BOUNDARIES,  CALLED  FROM  FDTDER'/ 
2X, 'E=' ,E12.5,2X, 'Y7(l)=' ,E12.5  2X, 'Y7(9)=' ,E12.5) 

STOP 
ELSE 
END  IF 
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I  =  I  I 
J=JJ 

IF( i 1 , Fg. 0)  1=11+1 
IF(II.EQ.8)  1=11-1 
IF(JJ.EQ.O)  J=JJ+1 
IF(JJ.EQ.8)  J=JJ-1 
DTDER1=F7( I , J) 

>  +(F7( I+l, J)-F7( I , J) )/(X7( I+l)-X7( I ) )*(R-X7( I ) ) 

DTDER2=F7 ( I , J+1 ) 

->  M  F7  (  I  + 1 ,  J+ 1 )  - F7  {  I ,  J  + 1 )  )  / ( X7  ( I  + 1 )  -X7  (  I )  )  *  { R-X7  ( I )  ) 
DTDER=DTDER1 + ( DTDER2 -DTDERl ) /( Y7 ( J+ 1 ) - Y7 ( J ) ) * ( E- Y7 ( J ) ) 
FDTDER=DTDER 
RETURN 
END 

FUNCTION  FDMUDRE(R,E) 

DR=0 . 01+R 

CALL  UGAS3(E,R-DR/2. ,ZMU1) 

CALL  UGAS3 (E, R+DR/2 . , ZMU2 ) 

DMUDRE= { ZMU2 - ZMU 1 ) /DR 

FDMUDRE=DMUDRE 

RETURN 

END 

FUNCTION  FDMUDER(R,E) 

DE=0. 01*E 

CALL  UGAS3(E-DE/2. ,R,ZMU1) 

CALL  UGAS3(E+DE/2. ,R,ZMU2) 

DMUDER=  (  ZtviU2  -  ZMU  1 )  /DE 

FDMUDER=DMUDER 

RETURN 

END 

FUNCTION  FDKDRE(R,E) 

DR=0. 01*R 

CALL  UGAS4(E,R-DR/2. ,ZK1) 

CALL  UGAS4 ( E , R+DR/2 . , ZK2 ) 

DKDRE= ( ZK2-ZK1 )/DR 

FDKDRE=DKDRE 

RETURN 

END 

FUNCTION  FDKDER(R,E) 

DE=0. 01+E 

CALL  UGAS4(E-DE/2 . , R, ZKl ) 

CALL  UGAS4(E+DE/2 . , R, ZK2 ) 

DKDER=(ZK2-ZK1 )/DE 

FDKDER=DKDER 

RETURN 

END 

FUNCTION  FAR(P,R,T,E, AMW) 

DMDRT=FDMDRT ( R , T ) 

DMDTR=FDMDTR ( R , T ) 

DTDRE=FDTDRE(R,E) 

BR=1 . -R/AMW*DMDRT 

BT=1 . -T/AMW+DMDTR 

FAR=P/R*BR+P/T*BT*DTDRE 

RETURN 

END 
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FUNCTION  FAE(P, R, T, E, AMW) 

DMDRT--FDMDRT  (  R ,  T ) 

DMDTR-^FDMDTR  (  R ,  T ) 

OTHER- FDTDER( R, E) 

BR-1 . -R/AMW*DMDRT 

BT-1 . -T/AKW-DMDTR 

FAE=P/T*BT*DTDER 

RETURN 

END 

FUNCTION  FC02(P,R,T,E,AMW) 

COMPUTING  OF  SPEED  OF  SOUND  -  C**2 
P  -  PRESSURE 
R  -  DENSITY 
T  -  TEMPERATURE 
E  -  INTERNAL  ENERGY 
AMW  -  MOLECULAR  WEIGHT 
DMDRT=FDMDRT ( R , T ) 

DMDTR-FDMDTR ( R , T ) 

DTDRE-FDTDRE(R, E) 

DTDER^FDTDER(R, E) 

BR--^]  .  -R/AMW*DMDRT 
BT  . -T/AMW*DMDTR 

FC02=P/PC-BR*P/T*BT*(DTDRE+P/R**2*DTDER) 

RETURN 

END 

SUBROUTINE  SUPPLY 

******  +  -,*-+****^  + *  +  ■*********************************************** 
★ 

*  SERVICE  SUBROUTINE 

* 

******7ir  +  * +  :«-**■*************************************************** 

PARAMETER  ( 1 2^60 , JZ=40 ) 

COMMON 


COMMON 

> 

COMMON 


common 

> 

DIMENSION  RHO( IZ, JZ) ,RHOU( IZ, JZ) ,RHOV( I Z , JZ ) , EO ( I Z , JZ ) 
EQUIVALENCE  (Q( 1 , 1, 1) , RHO( 1, 1) ) , (Q( 1 , 1 , 2 ) , RHOU( 1 , 1 ) ) , 

>  (Q(l,l,3),RHOV(l,l)), (Q(1,1,4),E0(1,1)) 

DIMENSION  SS(4) , A(4. 4) 

-k'k-k^ir-kit'k^^if-k^'k-k-k-k'k-k'kk^-k'k-k-k-k-k-k'k-k-k'k'k'k'kie'kie'k'k-k'kir'k'k'k'k'k'k’k'kie'k'k'k'k'k'k'k'k'kic’k 

ENTRY  CHECK 

DO  10  K^l,4 
10  SS(K)-0. 

DO  20  1^2, IL 


/VECTOR/  DQ( IZ, JZ,4) ,Q(IZ, JZ,4) ,F( 12, JZ,4) , 

G{ IZ, JZ, 4) ,  P( IZ, JZ) ,T( IZ, JZ) ,E( IZ, JZ) , AMW( IZ, JZ) , 

U( IZ, JZ) , V( IZ, JZ) ,UN( IZ, JZ) , VN( IZ, JZ) , 

ZMU ( JZ ) , ZMUT ( JZ ) , ZK ( JZ ) 

/COORD/  SAIX( IZ, JZ) ,SAIY(IZ, JZ),ETAX(IZ, JZ) , 

ETAY( IZ, JZ) , RJ( IZ, JZ) ,X( IZ, JZ) , Y( IZ, JZ) , 

DELTAU( IZ, JZ) , Al( IZ, JZ),A2(IZ, JZ) , A3(IZ, JZ) , 

A4( IZ, JZ) 

/CONS/  EXI , EYI , THETA, CFL,CFL1,0MEGAX, OMEGAY, AIN, AEX, 
P  L , RG , AMWO , GAMMAO , REN , PRN , PRNT , TREF , ZMUO , OMEGA , 

PO , TO , TWALL , PB , SUM ( 4 ) 

/INTEG/  IL, JL, ILl, JL1,NBEG,NEND,NADV,N0RD, ITIME, 
IVISC, IWALL, IWRT 
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DO  20  J=2,JL 
DO  20  ,  4 

QQ-Q(I, J,K) 

IF(K.EQ.3)  QQ=Q(I,J,2) 

IF(QQ.EQ.O.O)  GO  TO  20 

SS(K)=SS(K)+(DQ( I, J,K)*RJ( I, J)/Y(I, J)/QQ)**2 
20  CONTINUE 
DO  30  K=l,4 

30  SS(K)=SQRT(SS(K) )/( IL*JL) 

WRITE  (6,500)  NADV, (SS(K) ,K=1, 4) 

500  FORMAT (2X, 'NADV=' , 14, 4X, ' SS ( 1 )=' , 1X,E12 .7, 

>  2X, 'SS(2)=' ,1X,E12.7,2X, 'SS(3)=' ,1X,E12.7, 

>  2X, ' SS(4)=' , 1X,E12 . 7 ) 

WRITE  (10,501)  NADV, (SS(K) ,K=1,4) 

501  F0RMAT(I5,3X,4(1X,E14.7) ) 

RETURN 

ENTRY  MASS 

PI-^AC0S(  -1 . 0) 

1^1 

FLRT^O. 

DO  41  J=1,JL1 

DR=SQRT( (X(I, J+1)-X(I, J) )**2+(Y(I, J+1)-Y(I, J) )**2) 
CXCY1=SQRT(SAIX( I , J)**2+SAIY( I,J)**2) 

CXCY2=SQRT(SAIX( I, J+1)**2+SAIY( I, J+l)**2) 
FLRT=FLRT+0.5*PI*(Y(I, J)+Y(I, J+1))*DR* 

>  (RHO( I , J)*UN( I , J)/CXCY1+RH0( I, J+1 )*UN( I, J+1)/CXCY2) 

41  CONTINUE 

WRITE  (5,502)  I , FLRT 
WRITE  (4,503)  I , FLRT 
DO  40  1^1, ILl 
FLRT^O . 

DO  50  J^1,JL1 

DR1=SQRT(  (X(I,  J-»1)-X(I,  J)  )**2  +  (Y(I,  J+1)-Y(I,  J)  )**2) 
DR2=SQFT( (X(I+1,J+1)-X(I+1,J) )**2+(Y( I+l , J+ 1 ) -Y( I + 1 , J ) ) **2 ) 
DR-^0. 6*(DR1+DR2) 

* 

*  1ST  ORDER 

•k 

CXCY11=SQRT(SAIX( I , J ) **2 + SAI Y( I , J ) **2 ) 

CXCY12=SQRT(SAIX( I+l, J)**2+SAIY( I+l, J)**2 ) 

CXCY1=0 . 5* (CXCY11+CXCY12 ) 

CXCY21=SQRT(SAIX(I, J+1)**2+SAIY(I, J+l)**2) 

CXCY22=SgRT(SAIX( I+l, J+1)**2+SAIY( I+l, J+l)**2) 

CXCY2=0 . 5* (CXCY21+CXCY22 ) 

RHOUNl^^O.  5*  (RH0(  I  ,  J)*UN(  I ,  J)/CXCY11 

+RHO( I+l, J)*UN( I+l, J)/CXCY12) 

RHOUN2=0.5*(RHO( I, J+1)*UN( I , J+ 1 )/CXCY2 1 

>  +RH0( I+l, J+1 )*UN( I+l, J+1)/CXCY22) 

IF( I -EQ. ILl)  GO  TO  59 

CALL  JCBABPM(1, 1, 1,A, I, J) 

AQ1=0. 

DO  51  JJ=1 , 4 

51  AQ1^AQ1+A(1, JJ)*(Q(I+1, J, JJ)-Q(I,J,JJ) ) 
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CALL  JCBABPM( 1, 1, 1, A, I , J+1 ) 

AQ2=0 . 

DO  5  2 

52  AQJ-AQ2.  ^  A  (  1 ,  J  J  )  *  ( Q  {  H  1 ,  J+ 1 ,  J  J  ) -y  (  I ,  J +  i ,  J  J  )  ) 
RHOUNl-RHOUNl-0 . 5*AQ1/CXCY1 
RHOUN2=RHOUN2-0 . 5*AQ2/CXCY2 

CAI.L  JCBABPM(  1, 2, 1,  A,  I  ,  J) 

AQ1=0. 

DO  53  JJ=1,4 

53  AQ1=AQ1+A( 1, JJ)* (Q( I+l, J, JJ)-Q( I , J, JJ) ) 

CALL  JCBABPM( 1 , 2 , 1 , A, I , J+1 ) 

AQ2=0. 

DO  54  JJ=1,4 

54  AQ2=AQ2+A(1. JJ)*(Q( I+l, J+1, JJ)-Q(I, J+1, JJ) ) 
RHOUNl-RHOUNl+0 . 5*AQ1/CXCY1 
RHOUN2=RHOUN2+0. 5*AQ2/CXCY2 

2ND  ORDER 

I F ( I . GT . 1 . AND . I . LT . I  LI )  THEN 

CXCY11--SQRT(  SAIX(  I  - 1 ,  J  )  *  *2  +  SAIY(  I-l,  J)**2  ) 
CXCY12=SQRT(SAIX( I, J)**2+SAIY(I, J)**2) 

CXCY1=0. 5*(CXCY11+CXCY12) 

CXCY21=SQRT(SAIX( I-l, J+1)**2+SAIY( I-l, J+l)**2) 
CXCY22^SQRT(SAIX( I, J+1)**2+SAIY{I, J+l)**2) 
CXCY2=0 . 5* (CXCY21+CXCY22 ) 

CALL  JCBABPM( 1, 1, 1, A, I-l, J) 

AQl--"0  . 

DO  55  JJ^1,4 

55  Agl^AQl+A( 1, JJ)* (Q( I , J , J J ) -Q( I - 1 , J, JJ ) ) 

CALL  JCBABPMd,  1,1,A,I-1,J  +  1) 

AQ2=0. 

DO  56  JJ---U,4 

56  AQ2-^AQ2+A(1,  JJ)*(Q(  I,  J+1,  JJ)-Q(I-1,  J  +  1,  JJ)  ) 
RHOUN 1 =RHOUN 1 + 0 . 5 * AQ 1 /CXCY 1 
RHOUN2=RHOUN2+0 . 5*AQ2/CXCY2 

CXCY11=SQRT(SAIX( I+l ,T)**2+sAIY(I+1, J)**2) 
CXCY12=SQRT(SAIX( 1+2, J)**2  +  SAIY(I  +  2,  J)**2) 
CXCY1=0. 5* (CXCY11+CXCY12 ) 

CXCY21=SQRT(SAIX( I+l, J+1)**2+SAIY(I+1, J+l)**2) 
CXCY22=SQRT(SAIX( I +2 , J+ 1 ) * *2+SAIY( I +2 , J+ 1 ) * *2 ) 
CXCY2=0. 5* (CXCY21+CXCY22 ) 

CALL  JCBABPM( 1 , 2 , 1 , A, I+l , J) 

AQl-0. 

DO  57  JJ=1,4 

57  AQ1=AQ1+A( 1, JJ)*(Q( 1+2, J, JJ)-Q(I+1, J, JJ) ) 

CALL  JCBABPM( 1,2, 1, A, I+l, J+1) 

AQ2^0 . 

DO  58  JJ=1,4 

58  AQ2=AQ2+A(1, JJ)*(Q(I+2, J+1, JJ)-Q(I+1, J+1, JJ) ) 
RHOUN 1 =RHOUN 1 - 0 . 5  *  AQ 1 /CXCY 1 
RHOUM2=RHOUN2-0 . 5+AQ2/CXCY2 

END  IF 

59  CONTINUE 

Y1-0.5*(Y( I, J)+Y(I+1, J) ) 
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Y2-0.5*(Y(I, J+1)+Y(I+1, J+1) ) 

FLRT-FLRT  ^0 . 5*PI * ( Y1+Y2 ) *DR* ( RH0UN1  +  RH0UN2 ) 

50  CONTINUE 
11=1+1 

WRITE  (6,502)  1 1 , FLRT 

502  F0RMAT(1X, ' 1=' , 14, 2X, 'FLRT=' ,E14.7) 

WRITE  (4,503)  I I , FLRT 

503  FORMAT( IX, 18, E14. 7 ) 

40  CONTINUE 

RETURN 

******  *********-*****>r******************************************* 

ENTRY  OUTPUT 

***************************************************************** 
IF( IWRT.EQ.O)  GO  TO  60 
WRITE  (6.504)  NEND 

504  FORMAT (//4X, ' NEND= ' , 15//) 

DO  70  1=1, IL 

WRITE  (6,505)  I 

505  FORMAT ( //2X, 2HI=, 12, 4X, IHX, IIX, IHY, IIX, IHU, IIX, IHV, IIX, 

IHP, IIX, IHR, IIX, IHT, IIX, IHE, IIX, IHS, IIX, IHM/) 

DO  70  J=1,JL 
RA=RHO( I , J) 

UA=RHOU ( I , J ) /RHO ( I , J ) 

VA=RHOV ( I , J ) /RHO ( I , J ) 

EOA=EO( I , J) 

EA=E0A/RA-0 . 5* (UA**2+VA**2 ) 

TA=FT(RA, EA) 

amv;a=famw(ra,ta) 

PA=RA* ( RG/AMWA ) *TA 
GAMMA= 1 . + ( RG/AMWA ) / ( EA/TA ) 

SA=ALOG ( PA ) /GAMMA- ALOG ( RA ) 

C0=SQRT(FC02(PA,RA,TA,EA,AMWA) ) 

AMACH=SQRT(UA**2+VA**2 )/C0 

WRITE  (6,506)  J , X ( I , J ) , Y( I , J ) , UA, VA, PA, RA, TA, EOA, SA, AMACH 

506  FORMAT(2X,2HJ=, 12 , 10( IX, Ell . 4) ) 

70  CONTINUE 

60  CONTINUE 

* 

*  WRITING  COMPUTED  DATA  ON  TAPE 

* 

WRITE  (8)  ( (DELTAU( I , J) , 1=1, IL) , J=l, JL) 

WRITE  (8)  ((RHO(I, J),RHOU(I,J),RHOV(I,J),EO(I,J), 

>  1=1, IL) , J=l, JL) 

RETURN 

END 

SUBROUTINE  EEL ( J , MM, UMAX , E , EL, AM, BM, CM, DM, IN,AL,BE) 
**************************************************************** 
★ 

*  LIBRARY  SUBROUTINES 

★ 

**************************************************************** 
DIMENSION  IN(MM) ,E(MM,MM, UMAX) ,EL(MM, UMAX) 

DIMENSION  AM(MM,MM) ,BM(MM,MM) ,CM{MM,MM) ,DM(MM) 

DIMENSION  AL(MM,MM) ,BE(MM) 

DO  1  M=1,MM 
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TP=0. 00 
DO  2  N=1,MM 
Tl^-0 . 00 

IF( J.EQ. 1)  GO  TO  3 
TP=TP+AM(M,N)*EL(N, J-1) 

DO  4  K=1,MM 

T1=T1+AM(M, K)*E(K,N, J-1) 

4  CONTINUE 

3  CONTINUE 
AL(M,N):=BM(M,N)-T1 

2  CONTINUE 

EL(M, J)=DM(M)+TP 
1  CONTINUE 
DO  5 

DO  6  N:^1,MM 
E(M,N, J)=CM(M,N) 

6  CONTINUE 

5  CONTINUE 

CALL  AXB(MM,MM, AL,E(1, 1 , J ) , BE , 0, IN) 

CALL  AXB(MIVI,  1 ,  AL,  EL(  1 ,  J)  ,  BE,  1 ,  IN) 

RETURN 

END 

SUBROUTINE  SOLU( W, UMAX, MM, E, EL) 

********•*****•*  +  ■*•************************************************ 
* 

*  IJPRARY  SUBROUTINES 

* 

**************************************************************** 
DIMENSION  W(MM, UMAX) , E(MM, MM, JMAX) , EL(MM, UMAX) 

DO  1  M=1,MM 

W(M, JMAX)=EL(M, JMAX) 

1  CONTINUE 

DO  2  J1=2,JMAX 
J-JMAX+l-Jl 
DO  3  M=1,MM 
SUM=0 . 00 
DO  4  K=1,MM 

SUM=SUM+E(M,K, J)*W(K, J+1) 

4  CONTINUE 

W(M,  I  )^SUM  +  EL(M, J) 

3  CONTINUE 

2  CONTINUE 
RETURN 
END 

SUBROUTINE  AXB(N, M, A, B, X, INIT, IPS) 


*  L I BRARY  SUBROUTINES 

* 

■kicic'k'kir'kir-kic-^icicieirieic9r^9ciricieitic'^if'kic:kiciricirie'k':fFicifieici('kieicicii:ir'kieic'k'kir'kic'kicicic'k'fr'ic'k 

DIMENSION  A(N,N),B(N,M), IPS(N) ,X(N) 

IF( INIT.EQ.O)  CALL  DECOMP(N, A, IPS) 

DO  1  I::^1,M 

CALL  SOLV(N, A,B( 1, I ) ,X, IPS) 

1  CONTIinJE 
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RETURN 

END 

SUBROUT  I NE  DECOMP ( N , UL , I  PS ) 


*  LIBRARY  SUBROUTINES 

* 

DIMENSION  UL(N, N) , IPS(N) 

DO  1  1=1, N 
IPS( I )=I 

1  CONTINUE 
NM1=N-1 

DO  2  K=1,NM1 
BIG=0. 00 
DO  3  I=K,N 
IP=IPS( I ) 

SIZE=ABS(UL( IP,K) ) 
IF(SIZE-BIG)  3,3,4 

4  BIG=SIZE 
IDXPIV=I 

3  CONTINUE 

IF(IDXPIV-K)  5,6,5 

5  J=IPS(K) 

IFS(K)=IPS( IDXPIV) 

IPS( IDXPIV)=J 

6  KP=IPS(K) 

PIVOT=UL(KP, K) 

KP1=K+1 

DO  7  I=KP1,N 
IP=IPS(  I  ) 

EM=-UL( IP, K)/riVOT 
UL( IP, K)=-EM 
DO  7  J-=KP1,N 

UL( IP, J)=UL( IP, J)+EM*UL(KP, J) 

7  CONTINUE 

2  CONTINUE 
RETURN 
END 

SUBROUTINE  SOLV { N, UL, B, X, IPS ) 


*  LIBRARY  SUBROUTINES 

* 

u  1 I  on  UL(N,N),B(N),X(N),IPS(N) 

NP1=N+1 

IP=IPS(1) 

X(1)-B{IP) 

DO  1  1=2, N 
IP=IPS( I  ) 

IM1=I-1 
SUM=0 . 00 
DO  2  J=1,IM1 
SUM=SUM+UL( IP, J)*X( J) 
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2  CONTINUE 

X( I )=B( IP)-SUM 
1  CONTINUE 
IP=IPS(N) 

B(N)=X(N)/UL( IP,N) 

DO  3  IBACK=2,N 
I-NPl-IBACK 
IP=IPS( I ) 

IP1=I+1 
SUM=0 . 00 
DO  4  J--=IP1,N 
SUM^SUM+UL( IP, J)*B( J) 

4  CONTINUE 

B( I )=(X( I )-SUM)/UL( IP, I ) 

3  CONTINUE 
RETURN 
END 

SUBROUTINE  SZERO(M,A) 

* 

*  LIBRARY  SUBROUTINES 

* 

SET  ZERO  FOR  MATRIC  (M,M) 
DIMENSION  A(M,M) 

DO  1  1=1, M 
DO  1  J=1,M 
A( I , J)=0. 00 
1  CONTINUE 
RETURN 
END 

SUBROUTINE  SMM(M,C,A,B) 

* 

*  LIBRARY  SUBROUTINES 

* 

SCALAR*METRIC  (M,M) 

DIMENSION  A(M,M) ,B(M,M) 

DO  1  1=1, M 
DO  1  J=1,M 
B(  I  , J)=C*A( I , J) 

1  CONTINUE 
RETURN 
END 

SUBROUTINE  MMM(M,A,B,C) 

★ 

*  LIBRARY  SUBROUTINES 

* 

METRIX*METRIX  (M*M) 

DIMENSION  A(M,M) ,B(M,M) ,C(M,M) 
DO  1  1=1, M 
DO  1  J=1,M 
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C( I , J)=0.00 
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